utils/build_path_prefix_map.cmi
utils/build_path_prefix_map.cmi :
utils/ccomp.cmo : \
+ utils/profile.cmi \
utils/misc.cmi \
utils/load_path.cmi \
utils/config.cmi \
utils/clflags.cmi \
utils/ccomp.cmi
utils/ccomp.cmx : \
+ utils/profile.cmx \
utils/misc.cmx \
utils/load_path.cmx \
utils/config.cmx \
utils/consistbl.cmi
utils/consistbl.cmi : \
utils/misc.cmi
+utils/domainstate.cmo : \
+ utils/domainstate.cmi
+utils/domainstate.cmx : \
+ utils/domainstate.cmi
+utils/domainstate.cmi :
utils/identifiable.cmo : \
utils/misc.cmi \
utils/identifiable.cmi
parsing/asttypes.cmi
parsing/pprintast.cmo : \
parsing/parsetree.cmi \
- utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
parsing/asttypes.cmi \
parsing/pprintast.cmi
parsing/pprintast.cmx : \
parsing/parsetree.cmi \
- utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
parsing/asttypes.cmi \
parsing/printast.cmo : \
parsing/pprintast.cmi \
parsing/parsetree.cmi \
- utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
parsing/asttypes.cmi \
parsing/printast.cmx : \
parsing/pprintast.cmx \
parsing/parsetree.cmi \
- utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
parsing/asttypes.cmi \
typing/btype.cmo : \
typing/types.cmi \
typing/path.cmi \
- utils/misc.cmi \
typing/ident.cmi \
parsing/asttypes.cmi \
typing/btype.cmi
typing/btype.cmx : \
typing/types.cmx \
typing/path.cmx \
- utils/misc.cmx \
typing/ident.cmx \
parsing/asttypes.cmi \
typing/btype.cmi
parsing/asttypes.cmi
typing/ctype.cmo : \
typing/types.cmi \
+ typing/type_immediacy.cmi \
typing/subst.cmi \
typing/predef.cmi \
typing/path.cmi \
typing/ctype.cmi
typing/ctype.cmx : \
typing/types.cmx \
+ typing/type_immediacy.cmx \
typing/subst.cmx \
typing/predef.cmx \
typing/path.cmx \
typing/ctype.cmi
typing/ctype.cmi : \
typing/types.cmi \
+ typing/type_immediacy.cmi \
typing/path.cmi \
parsing/longident.cmi \
typing/ident.cmi \
typing/includecore.cmo : \
typing/types.cmi \
typing/typedtree.cmi \
+ typing/type_immediacy.cmi \
+ typing/printtyp.cmi \
typing/path.cmi \
typing/ident.cmi \
typing/env.cmi \
typing/includecore.cmx : \
typing/types.cmx \
typing/typedtree.cmx \
+ typing/type_immediacy.cmx \
+ typing/printtyp.cmx \
typing/path.cmx \
typing/ident.cmx \
typing/env.cmx \
typing/includecore.cmi : \
typing/types.cmi \
typing/typedtree.cmi \
+ typing/type_immediacy.cmi \
typing/path.cmi \
parsing/location.cmi \
typing/ident.cmi \
- typing/env.cmi
+ typing/env.cmi \
+ typing/ctype.cmi
typing/includemod.cmo : \
typing/types.cmi \
typing/typedtree.cmi \
typing/types.cmi \
typing/subst.cmi \
typing/path.cmi \
- utils/misc.cmi \
parsing/location.cmi \
typing/ident.cmi \
typing/env.cmi \
typing/types.cmx \
typing/subst.cmx \
typing/path.cmx \
- utils/misc.cmx \
parsing/location.cmx \
typing/ident.cmx \
typing/env.cmx \
typing/oprint.cmi : \
typing/outcometree.cmi
typing/outcometree.cmi : \
+ typing/type_immediacy.cmi \
parsing/asttypes.cmi
typing/parmatch.cmo : \
utils/warnings.cmi \
typing/printtyp.cmo : \
utils/warnings.cmi \
typing/types.cmi \
+ typing/type_immediacy.cmi \
typing/primitive.cmi \
typing/predef.cmi \
typing/path.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/clflags.cmi \
- parsing/builtin_attributes.cmi \
typing/btype.cmi \
parsing/asttypes.cmi \
typing/printtyp.cmi
typing/printtyp.cmx : \
utils/warnings.cmx \
typing/types.cmx \
+ typing/type_immediacy.cmx \
typing/primitive.cmx \
typing/predef.cmx \
typing/path.cmx \
typing/env.cmx \
typing/ctype.cmx \
utils/clflags.cmx \
- parsing/builtin_attributes.cmx \
typing/btype.cmx \
parsing/asttypes.cmi \
typing/printtyp.cmi
parsing/printast.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
- utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
parsing/printast.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
- utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
typing/ident.cmx \
typing/typedtree.cmi \
typing/env.cmi \
parsing/asttypes.cmi
+typing/type_immediacy.cmo : \
+ parsing/builtin_attributes.cmi \
+ typing/type_immediacy.cmi
+typing/type_immediacy.cmx : \
+ parsing/builtin_attributes.cmx \
+ typing/type_immediacy.cmi
+typing/type_immediacy.cmi : \
+ parsing/parsetree.cmi
typing/typeclass.cmo : \
utils/warnings.cmi \
typing/typetexp.cmi \
typing/typedecl_variance.cmi \
typing/typedecl_unboxed.cmi \
typing/typedecl_immediacy.cmi \
+ typing/type_immediacy.cmi \
typing/subst.cmi \
typing/printtyp.cmi \
typing/primitive.cmi \
typing/typedecl_variance.cmx \
typing/typedecl_unboxed.cmx \
typing/typedecl_immediacy.cmx \
+ typing/type_immediacy.cmx \
typing/subst.cmx \
typing/printtyp.cmx \
typing/primitive.cmx \
typing/types.cmi \
typing/typedecl_unboxed.cmi \
typing/typedecl_properties.cmi \
+ typing/type_immediacy.cmi \
parsing/location.cmi \
typing/ctype.cmi \
- parsing/builtin_attributes.cmi \
typing/typedecl_immediacy.cmi
typing/typedecl_immediacy.cmx : \
typing/types.cmx \
typing/typedecl_unboxed.cmx \
typing/typedecl_properties.cmx \
+ typing/type_immediacy.cmx \
parsing/location.cmx \
typing/ctype.cmx \
- parsing/builtin_attributes.cmx \
typing/typedecl_immediacy.cmi
typing/typedecl_immediacy.cmi : \
typing/types.cmi \
typing/typedecl_properties.cmi \
+ typing/type_immediacy.cmi \
parsing/location.cmi \
typing/ident.cmi \
typing/env.cmi
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
- utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
typing/primitive.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
- utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
typing/ident.cmx \
lambda/lambda.cmi \
typing/env.cmi
typing/types.cmo : \
+ typing/type_immediacy.cmi \
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/asttypes.cmi \
typing/types.cmi
typing/types.cmx : \
+ typing/type_immediacy.cmx \
typing/primitive.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
parsing/asttypes.cmi \
typing/types.cmi
typing/types.cmi : \
+ typing/type_immediacy.cmi \
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
- typing/includemod.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/clflags.cmi \
utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
- typing/includemod.cmx \
typing/env.cmx \
typing/ctype.cmx \
utils/clflags.cmx \
parsing/parsetree.cmi \
parsing/longident.cmi \
parsing/location.cmi \
- typing/includemod.cmi \
typing/env.cmi \
typing/ctype.cmi \
parsing/asttypes.cmi
typing/typedtree.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
- utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
typing/typedtree.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
- utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
typing/ident.cmx \
utils/config.cmx \
utils/clflags.cmx
asmcomp/asmgen.cmo : \
- middle_end/flambda/un_anf.cmi \
lambda/translmod.cmi \
- middle_end/symbol.cmi \
asmcomp/split.cmi \
asmcomp/spill.cmi \
asmcomp/selection.cmi \
asmcomp/printmach.cmi \
asmcomp/printlinear.cmi \
asmcomp/printcmm.cmi \
- middle_end/printclambda.cmi \
typing/primitive.cmi \
- typing/path.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
parsing/location.cmi \
asmcomp/liveness.cmi \
asmcomp/linscan.cmi \
- middle_end/linkage_name.cmi \
asmcomp/linearize.cmi \
lambda/lambda.cmi \
asmcomp/interval.cmi \
asmcomp/interf.cmi \
typing/ident.cmi \
- middle_end/flambda/flambda_to_clambda.cmi \
- middle_end/flambda/flambda.cmi \
asmcomp/emitaux.cmi \
asmcomp/emit.cmi \
asmcomp/deadcode.cmi \
asmcomp/comballoc.cmi \
asmcomp/coloring.cmi \
asmcomp/cmmgen.cmi \
+ asmcomp/cmm_helpers.cmi \
asmcomp/cmm.cmi \
- middle_end/closure/closure.cmi \
utils/clflags.cmi \
middle_end/clambda.cmi \
asmcomp/CSE.cmo \
- middle_end/flambda/build_export_info.cmi \
+ middle_end/backend_intf.cmi \
asmcomp/debug/available_regs.cmi \
asmcomp/asmgen.cmi
asmcomp/asmgen.cmx : \
- middle_end/flambda/un_anf.cmx \
lambda/translmod.cmx \
- middle_end/symbol.cmx \
asmcomp/split.cmx \
asmcomp/spill.cmx \
asmcomp/selection.cmx \
asmcomp/printmach.cmx \
asmcomp/printlinear.cmx \
asmcomp/printcmm.cmx \
- middle_end/printclambda.cmx \
typing/primitive.cmx \
- typing/path.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
parsing/location.cmx \
asmcomp/liveness.cmx \
asmcomp/linscan.cmx \
- middle_end/linkage_name.cmx \
asmcomp/linearize.cmx \
lambda/lambda.cmx \
asmcomp/interval.cmx \
asmcomp/interf.cmx \
typing/ident.cmx \
- middle_end/flambda/flambda_to_clambda.cmx \
- middle_end/flambda/flambda.cmx \
asmcomp/emitaux.cmx \
asmcomp/emit.cmx \
asmcomp/deadcode.cmx \
asmcomp/comballoc.cmx \
asmcomp/coloring.cmx \
asmcomp/cmmgen.cmx \
+ asmcomp/cmm_helpers.cmx \
asmcomp/cmm.cmx \
- middle_end/closure/closure.cmx \
utils/clflags.cmx \
middle_end/clambda.cmx \
asmcomp/CSE.cmx \
- middle_end/flambda/build_export_info.cmx \
+ middle_end/backend_intf.cmi \
asmcomp/debug/available_regs.cmx \
asmcomp/asmgen.cmi
asmcomp/asmgen.cmi : \
lambda/lambda.cmi \
- typing/ident.cmi \
- middle_end/flambda/flambda.cmi \
asmcomp/cmm.cmi \
+ middle_end/clambda.cmi \
middle_end/backend_intf.cmi
asmcomp/asmlibrarian.cmo : \
utils/misc.cmi \
utils/config.cmi \
middle_end/compilenv.cmi \
file_formats/cmx_format.cmi \
- asmcomp/cmmgen.cmi \
+ asmcomp/cmm_helpers.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
utils/ccomp.cmi \
utils/config.cmx \
middle_end/compilenv.cmx \
file_formats/cmx_format.cmi \
- asmcomp/cmmgen.cmx \
+ asmcomp/cmm_helpers.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
utils/ccomp.cmx \
middle_end/compilenv.cmi \
middle_end/compilation_unit.cmi \
file_formats/cmx_format.cmi \
+ middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
utils/ccomp.cmi \
asmcomp/asmlink.cmi \
middle_end/compilenv.cmx \
middle_end/compilation_unit.cmx \
file_formats/cmx_format.cmi \
+ middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
utils/ccomp.cmx \
asmcomp/asmlink.cmx \
asmcomp/branch_relaxation.cmo : \
utils/misc.cmi \
asmcomp/mach.cmi \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
asmcomp/cmm.cmi \
asmcomp/branch_relaxation_intf.cmo \
asmcomp/branch_relaxation.cmi
asmcomp/branch_relaxation.cmx : \
utils/misc.cmx \
asmcomp/mach.cmx \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
asmcomp/cmm.cmx \
asmcomp/branch_relaxation_intf.cmx \
asmcomp/branch_relaxation.cmi
asmcomp/branch_relaxation.cmi : \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
asmcomp/branch_relaxation_intf.cmo
asmcomp/branch_relaxation_intf.cmo : \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
asmcomp/cmm.cmi \
asmcomp/arch.cmo
asmcomp/branch_relaxation_intf.cmx : \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
asmcomp/cmm.cmx \
asmcomp/arch.cmx
asmcomp/cmm.cmo : \
lambda/debuginfo.cmi \
middle_end/backend_var.cmi \
parsing/asttypes.cmi \
- asmcomp/arch.cmo \
asmcomp/cmm.cmi
asmcomp/cmm.cmx : \
utils/targetint.cmx \
lambda/debuginfo.cmx \
middle_end/backend_var.cmx \
parsing/asttypes.cmi \
- asmcomp/arch.cmx \
asmcomp/cmm.cmi
asmcomp/cmm.cmi : \
utils/targetint.cmi \
lambda/debuginfo.cmi \
middle_end/backend_var.cmi \
parsing/asttypes.cmi
-asmcomp/cmmgen.cmo : \
- middle_end/flambda/un_anf.cmi \
- typing/types.cmi \
+asmcomp/cmm_helpers.cmo : \
utils/targetint.cmi \
lambda/switch.cmi \
asmcomp/strmatch.cmi \
asmcomp/proc.cmi \
- middle_end/printclambda_primitives.cmi \
typing/primitive.cmi \
utils/numbers.cmi \
utils/misc.cmi \
middle_end/backend_var.cmi \
parsing/asttypes.cmi \
asmcomp/arch.cmo \
- asmcomp/afl_instrument.cmi \
- asmcomp/cmmgen.cmi
-asmcomp/cmmgen.cmx : \
- middle_end/flambda/un_anf.cmx \
- typing/types.cmx \
+ asmcomp/cmm_helpers.cmi
+asmcomp/cmm_helpers.cmx : \
utils/targetint.cmx \
lambda/switch.cmx \
asmcomp/strmatch.cmx \
asmcomp/proc.cmx \
- middle_end/printclambda_primitives.cmx \
typing/primitive.cmx \
utils/numbers.cmx \
utils/misc.cmx \
middle_end/backend_var.cmx \
parsing/asttypes.cmi \
asmcomp/arch.cmx \
+ asmcomp/cmm_helpers.cmi
+asmcomp/cmm_helpers.cmi : \
+ utils/targetint.cmi \
+ typing/primitive.cmi \
+ parsing/location.cmi \
+ lambda/lambda.cmi \
+ lambda/debuginfo.cmi \
+ file_formats/cmx_format.cmi \
+ asmcomp/cmmgen_state.cmi \
+ asmcomp/cmm.cmi \
+ middle_end/clambda_primitives.cmi \
+ middle_end/clambda.cmi \
+ parsing/asttypes.cmi
+asmcomp/cmmgen.cmo : \
+ typing/types.cmi \
+ middle_end/printclambda_primitives.cmi \
+ typing/primitive.cmi \
+ utils/misc.cmi \
+ lambda/lambda.cmi \
+ lambda/debuginfo.cmi \
+ utils/config.cmi \
+ middle_end/compilenv.cmi \
+ asmcomp/cmmgen_state.cmi \
+ asmcomp/cmm_helpers.cmi \
+ asmcomp/cmm.cmi \
+ utils/clflags.cmi \
+ middle_end/clambda_primitives.cmi \
+ middle_end/clambda.cmi \
+ middle_end/backend_var.cmi \
+ parsing/asttypes.cmi \
+ asmcomp/arch.cmo \
+ asmcomp/afl_instrument.cmi \
+ asmcomp/cmmgen.cmi
+asmcomp/cmmgen.cmx : \
+ typing/types.cmx \
+ middle_end/printclambda_primitives.cmx \
+ typing/primitive.cmx \
+ utils/misc.cmx \
+ lambda/lambda.cmx \
+ lambda/debuginfo.cmx \
+ utils/config.cmx \
+ middle_end/compilenv.cmx \
+ asmcomp/cmmgen_state.cmx \
+ asmcomp/cmm_helpers.cmx \
+ asmcomp/cmm.cmx \
+ utils/clflags.cmx \
+ middle_end/clambda_primitives.cmx \
+ middle_end/clambda.cmx \
+ middle_end/backend_var.cmx \
+ parsing/asttypes.cmi \
+ asmcomp/arch.cmx \
asmcomp/afl_instrument.cmx \
asmcomp/cmmgen.cmi
asmcomp/cmmgen.cmi : \
- file_formats/cmx_format.cmi \
asmcomp/cmm.cmi \
middle_end/clambda.cmi
asmcomp/cmmgen_state.cmo : \
utils/misc.cmi \
+ middle_end/compilenv.cmi \
asmcomp/cmm.cmi \
middle_end/clambda.cmi \
asmcomp/cmmgen_state.cmi
asmcomp/cmmgen_state.cmx : \
utils/misc.cmx \
+ middle_end/compilenv.cmx \
asmcomp/cmm.cmx \
middle_end/clambda.cmx \
asmcomp/cmmgen_state.cmi
asmcomp/deadcode.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
+ utils/numbers.cmi \
asmcomp/mach.cmi \
utils/config.cmi \
+ asmcomp/cmm.cmi \
asmcomp/deadcode.cmi
asmcomp/deadcode.cmx : \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
+ utils/numbers.cmx \
asmcomp/mach.cmx \
utils/config.cmx \
+ asmcomp/cmm.cmx \
asmcomp/deadcode.cmi
asmcomp/deadcode.cmi : \
asmcomp/mach.cmi
asmcomp/proc.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
+ lambda/lambda.cmi \
asmcomp/emitaux.cmi \
+ utils/domainstate.cmi \
lambda/debuginfo.cmi \
utils/config.cmi \
middle_end/compilenv.cmi \
asmcomp/proc.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
+ lambda/lambda.cmx \
asmcomp/emitaux.cmx \
+ utils/domainstate.cmx \
lambda/debuginfo.cmx \
utils/config.cmx \
middle_end/compilenv.cmx \
asmcomp/arch.cmx \
asmcomp/emit.cmi
asmcomp/emit.cmi : \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
asmcomp/cmm.cmi
asmcomp/emitaux.cmo : \
lambda/debuginfo.cmi \
asmcomp/interval.cmi : \
asmcomp/reg.cmi \
asmcomp/mach.cmi
+asmcomp/linear.cmo : \
+ asmcomp/reg.cmi \
+ asmcomp/mach.cmi \
+ lambda/lambda.cmi \
+ lambda/debuginfo.cmi \
+ asmcomp/cmm.cmi \
+ asmcomp/linear.cmi
+asmcomp/linear.cmx : \
+ asmcomp/reg.cmx \
+ asmcomp/mach.cmx \
+ lambda/lambda.cmx \
+ lambda/debuginfo.cmx \
+ asmcomp/cmm.cmx \
+ asmcomp/linear.cmi
+asmcomp/linear.cmi : \
+ asmcomp/reg.cmi \
+ asmcomp/mach.cmi \
+ lambda/lambda.cmi \
+ lambda/debuginfo.cmi \
+ asmcomp/cmm.cmi
asmcomp/linearize.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
+ asmcomp/linear.cmi \
lambda/debuginfo.cmi \
utils/config.cmi \
asmcomp/cmm.cmi \
asmcomp/proc.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
+ asmcomp/linear.cmx \
lambda/debuginfo.cmx \
utils/config.cmx \
asmcomp/cmm.cmx \
asmcomp/linearize.cmi
asmcomp/linearize.cmi : \
- asmcomp/reg.cmi \
asmcomp/mach.cmi \
- lambda/debuginfo.cmi \
- asmcomp/cmm.cmi
+ asmcomp/linear.cmi
asmcomp/linscan.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
asmcomp/debug/reg_with_debug_info.cmi \
asmcomp/debug/reg_availability_set.cmi \
asmcomp/reg.cmi \
+ lambda/lambda.cmi \
lambda/debuginfo.cmi \
asmcomp/cmm.cmi \
middle_end/backend_var.cmi \
asmcomp/debug/reg_with_debug_info.cmx \
asmcomp/debug/reg_availability_set.cmx \
asmcomp/reg.cmx \
+ lambda/lambda.cmx \
lambda/debuginfo.cmx \
asmcomp/cmm.cmx \
middle_end/backend_var.cmx \
asmcomp/mach.cmi : \
asmcomp/debug/reg_availability_set.cmi \
asmcomp/reg.cmi \
+ lambda/lambda.cmi \
lambda/debuginfo.cmi \
asmcomp/cmm.cmi \
middle_end/backend_var.cmi \
asmcomp/cmm.cmi
asmcomp/printlinear.cmo : \
asmcomp/printmach.cmi \
- asmcomp/printcmm.cmi \
asmcomp/mach.cmi \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
+ lambda/lambda.cmi \
lambda/debuginfo.cmi \
asmcomp/printlinear.cmi
asmcomp/printlinear.cmx : \
asmcomp/printmach.cmx \
- asmcomp/printcmm.cmx \
asmcomp/mach.cmx \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
+ lambda/lambda.cmx \
lambda/debuginfo.cmx \
asmcomp/printlinear.cmi
asmcomp/printlinear.cmi : \
- asmcomp/linearize.cmi
+ asmcomp/linear.cmi
asmcomp/printmach.cmo : \
asmcomp/debug/reg_availability_set.cmi \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
asmcomp/printcmm.cmi \
asmcomp/mach.cmi \
+ lambda/lambda.cmi \
asmcomp/interval.cmi \
lambda/debuginfo.cmi \
utils/config.cmi \
asmcomp/proc.cmx \
asmcomp/printcmm.cmx \
asmcomp/mach.cmx \
+ lambda/lambda.cmx \
asmcomp/interval.cmx \
lambda/debuginfo.cmx \
utils/config.cmx \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
asmcomp/mach.cmi \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
asmcomp/arch.cmo \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
asmcomp/mach.cmx \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
asmcomp/arch.cmx \
asmcomp/schedgen.cmi
asmcomp/schedgen.cmi : \
asmcomp/mach.cmi \
- asmcomp/linearize.cmi
+ asmcomp/linear.cmi
asmcomp/scheduling.cmo : \
asmcomp/schedgen.cmi \
asmcomp/scheduling.cmi
asmcomp/schedgen.cmx \
asmcomp/scheduling.cmi
asmcomp/scheduling.cmi : \
- asmcomp/linearize.cmi
+ asmcomp/linear.cmi
asmcomp/selectgen.cmo : \
lambda/simplif.cmi \
asmcomp/reg.cmi \
utils/warnings.cmi \
typing/stypes.cmi \
typing/primitive.cmi \
- utils/misc.cmi \
parsing/location.cmi \
lambda/lambda.cmi \
typing/ident.cmi \
utils/warnings.cmx \
typing/stypes.cmx \
typing/primitive.cmx \
- utils/misc.cmx \
parsing/location.cmx \
lambda/lambda.cmx \
typing/ident.cmx \
lambda/lambda.cmi \
middle_end/clambda.cmi \
middle_end/backend_intf.cmi
+middle_end/closure/closure_middle_end.cmo : \
+ middle_end/printclambda.cmi \
+ typing/path.cmi \
+ lambda/lambda.cmi \
+ typing/ident.cmi \
+ middle_end/compilenv.cmi \
+ middle_end/closure/closure.cmi \
+ utils/clflags.cmi \
+ middle_end/clambda.cmi \
+ middle_end/closure/closure_middle_end.cmi
+middle_end/closure/closure_middle_end.cmx : \
+ middle_end/printclambda.cmx \
+ typing/path.cmx \
+ lambda/lambda.cmx \
+ typing/ident.cmx \
+ middle_end/compilenv.cmx \
+ middle_end/closure/closure.cmx \
+ utils/clflags.cmx \
+ middle_end/clambda.cmx \
+ middle_end/closure/closure_middle_end.cmi
+middle_end/closure/closure_middle_end.cmi : \
+ lambda/lambda.cmi \
+ middle_end/clambda.cmi \
+ middle_end/backend_intf.cmi
middle_end/flambda/alias_analysis.cmo : \
middle_end/variable.cmi \
middle_end/flambda/base_types/var_within_closure.cmi \
middle_end/flambda/base_types/closure_id.cmi
middle_end/flambda/effect_analysis.cmo : \
middle_end/semantics_of_primitives.cmi \
- utils/misc.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/flambda.cmi \
middle_end/clambda_primitives.cmi \
middle_end/flambda/effect_analysis.cmi
middle_end/flambda/effect_analysis.cmx : \
middle_end/semantics_of_primitives.cmx \
- utils/misc.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/flambda.cmx \
middle_end/clambda_primitives.cmx \
middle_end/flambda/simple_value_approx.cmi \
middle_end/flambda/base_types/set_of_closures_origin.cmi \
middle_end/flambda/base_types/set_of_closures_id.cmi \
- utils/misc.cmi \
middle_end/flambda/flambda_iterators.cmi \
middle_end/flambda/flambda.cmi \
middle_end/flambda/export_info.cmi \
middle_end/flambda/simple_value_approx.cmx \
middle_end/flambda/base_types/set_of_closures_origin.cmx \
middle_end/flambda/base_types/set_of_closures_id.cmx \
- utils/misc.cmx \
middle_end/flambda/flambda_iterators.cmx \
middle_end/flambda/flambda.cmx \
middle_end/flambda/export_info.cmx \
middle_end/flambda/parameter.cmi \
utils/numbers.cmi \
middle_end/flambda/base_types/mutable_variable.cmi \
- utils/misc.cmi \
lambda/lambda.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/flambda_iterators.cmi \
middle_end/flambda/parameter.cmx \
utils/numbers.cmx \
middle_end/flambda/base_types/mutable_variable.cmx \
- utils/misc.cmx \
lambda/lambda.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/flambda_iterators.cmx \
middle_end/flambda/flambda.cmi
middle_end/flambda/flambda_iterators.cmo : \
middle_end/variable.cmi \
- utils/misc.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/flambda.cmi \
middle_end/flambda/flambda_iterators.cmi
middle_end/flambda/flambda_iterators.cmx : \
middle_end/variable.cmx \
- utils/misc.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/flambda.cmx \
middle_end/flambda/flambda_iterators.cmi
middle_end/flambda/flambda_middle_end.cmo : \
utils/warnings.cmi \
middle_end/variable.cmi \
+ middle_end/flambda/un_anf.cmi \
middle_end/symbol.cmi \
middle_end/flambda/share_constants.cmi \
middle_end/flambda/remove_unused_program_constructs.cmi \
middle_end/flambda/remove_unused_closure_vars.cmi \
middle_end/flambda/ref_to_variables.cmi \
utils/profile.cmi \
+ middle_end/printclambda.cmi \
utils/misc.cmi \
parsing/location.cmi \
+ middle_end/linkage_name.cmi \
middle_end/flambda/lift_let_to_initialize_symbol.cmi \
middle_end/flambda/lift_constants.cmi \
middle_end/flambda/lift_code.cmi \
+ lambda/lambda.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/inlining_cost.cmi \
middle_end/flambda/inline_and_simplify.cmi \
middle_end/flambda/initialize_symbol_to_let_symbol.cmi \
+ middle_end/flambda/flambda_to_clambda.cmi \
middle_end/flambda/flambda_iterators.cmi \
middle_end/flambda/flambda_invariants.cmi \
middle_end/flambda/flambda.cmi \
lambda/debuginfo.cmi \
+ middle_end/compilenv.cmi \
middle_end/flambda/base_types/closure_id.cmi \
middle_end/flambda/closure_conversion.cmi \
utils/clflags.cmi \
+ middle_end/clambda.cmi \
+ middle_end/flambda/build_export_info.cmi \
middle_end/backend_intf.cmi \
middle_end/flambda/flambda_middle_end.cmi
middle_end/flambda/flambda_middle_end.cmx : \
utils/warnings.cmx \
middle_end/variable.cmx \
+ middle_end/flambda/un_anf.cmx \
middle_end/symbol.cmx \
middle_end/flambda/share_constants.cmx \
middle_end/flambda/remove_unused_program_constructs.cmx \
middle_end/flambda/remove_unused_closure_vars.cmx \
middle_end/flambda/ref_to_variables.cmx \
utils/profile.cmx \
+ middle_end/printclambda.cmx \
utils/misc.cmx \
parsing/location.cmx \
+ middle_end/linkage_name.cmx \
middle_end/flambda/lift_let_to_initialize_symbol.cmx \
middle_end/flambda/lift_constants.cmx \
middle_end/flambda/lift_code.cmx \
+ lambda/lambda.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/inlining_cost.cmx \
middle_end/flambda/inline_and_simplify.cmx \
middle_end/flambda/initialize_symbol_to_let_symbol.cmx \
+ middle_end/flambda/flambda_to_clambda.cmx \
middle_end/flambda/flambda_iterators.cmx \
middle_end/flambda/flambda_invariants.cmx \
middle_end/flambda/flambda.cmx \
lambda/debuginfo.cmx \
+ middle_end/compilenv.cmx \
middle_end/flambda/base_types/closure_id.cmx \
middle_end/flambda/closure_conversion.cmx \
utils/clflags.cmx \
+ middle_end/clambda.cmx \
+ middle_end/flambda/build_export_info.cmx \
middle_end/backend_intf.cmi \
middle_end/flambda/flambda_middle_end.cmi
middle_end/flambda/flambda_middle_end.cmi : \
lambda/lambda.cmi \
- typing/ident.cmi \
- middle_end/flambda/flambda.cmi \
+ middle_end/clambda.cmi \
middle_end/backend_intf.cmi
middle_end/flambda/flambda_to_clambda.cmo : \
middle_end/variable.cmi \
middle_end/flambda/base_types/var_within_closure.cmi \
+ middle_end/flambda/un_anf.cmi \
middle_end/flambda/base_types/tag.cmi \
middle_end/symbol.cmi \
middle_end/flambda/base_types/static_exception.cmi \
middle_end/flambda/export_info.cmi \
lambda/debuginfo.cmi \
middle_end/compilenv.cmi \
+ middle_end/compilation_unit.cmi \
middle_end/flambda/closure_offsets.cmi \
middle_end/flambda/base_types/closure_id.cmi \
utils/clflags.cmi \
middle_end/flambda/flambda_to_clambda.cmx : \
middle_end/variable.cmx \
middle_end/flambda/base_types/var_within_closure.cmx \
+ middle_end/flambda/un_anf.cmx \
middle_end/flambda/base_types/tag.cmx \
middle_end/symbol.cmx \
middle_end/flambda/base_types/static_exception.cmx \
middle_end/flambda/export_info.cmx \
lambda/debuginfo.cmx \
middle_end/compilenv.cmx \
+ middle_end/compilation_unit.cmx \
middle_end/flambda/closure_offsets.cmx \
middle_end/flambda/base_types/closure_id.cmx \
utils/clflags.cmx \
middle_end/flambda/base_types/set_of_closures_id.cmi \
middle_end/flambda/parameter.cmi \
utils/numbers.cmi \
- utils/misc.cmi \
utils/int_replace_polymorphic_compare.cmi \
utils/identifiable.cmi \
middle_end/flambda/flambda_utils.cmi \
middle_end/flambda/base_types/set_of_closures_id.cmx \
middle_end/flambda/parameter.cmx \
utils/numbers.cmx \
- utils/misc.cmx \
utils/int_replace_polymorphic_compare.cmx \
utils/identifiable.cmx \
middle_end/flambda/flambda_utils.cmx \
middle_end/flambda/lift_code.cmo : \
middle_end/variable.cmi \
utils/strongly_connected_components.cmi \
+ middle_end/flambda/base_types/mutable_variable.cmi \
+ lambda/lambda.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/flambda_iterators.cmi \
middle_end/flambda/flambda.cmi \
middle_end/flambda/lift_code.cmx : \
middle_end/variable.cmx \
utils/strongly_connected_components.cmx \
+ middle_end/flambda/base_types/mutable_variable.cmx \
+ lambda/lambda.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/flambda_iterators.cmx \
middle_end/flambda/flambda.cmx \
middle_end/flambda/ref_to_variables.cmo : \
middle_end/variable.cmi \
middle_end/flambda/base_types/mutable_variable.cmi \
- utils/misc.cmi \
lambda/lambda.cmi \
middle_end/internal_variable_names.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/ref_to_variables.cmx : \
middle_end/variable.cmx \
middle_end/flambda/base_types/mutable_variable.cmx \
- utils/misc.cmx \
lambda/lambda.cmx \
middle_end/internal_variable_names.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/base_types/export_id.cmi \
middle_end/flambda/base_types/closure_id.cmi
middle_end/flambda/un_anf.cmo : \
+ middle_end/symbol.cmi \
middle_end/semantics_of_primitives.cmi \
middle_end/printclambda.cmi \
utils/misc.cmi \
parsing/asttypes.cmi \
middle_end/flambda/un_anf.cmi
middle_end/flambda/un_anf.cmx : \
+ middle_end/symbol.cmx \
middle_end/semantics_of_primitives.cmx \
middle_end/printclambda.cmx \
utils/misc.cmx \
parsing/asttypes.cmi \
middle_end/flambda/un_anf.cmi
middle_end/flambda/un_anf.cmi : \
+ middle_end/symbol.cmi \
middle_end/clambda.cmi
middle_end/flambda/unbox_closures.cmo : \
middle_end/variable.cmi \
asmcomp/printlinear.cmi \
utils/numbers.cmi \
utils/misc.cmi \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
utils/int_replace_polymorphic_compare.cmi \
asmcomp/debug/compute_ranges_intf.cmo \
asmcomp/cmm.cmi \
asmcomp/printlinear.cmx \
utils/numbers.cmx \
utils/misc.cmx \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
utils/int_replace_polymorphic_compare.cmx \
asmcomp/debug/compute_ranges_intf.cmx \
asmcomp/cmm.cmx \
asmcomp/debug/compute_ranges_intf.cmo
asmcomp/debug/compute_ranges_intf.cmo : \
utils/numbers.cmi \
- asmcomp/linearize.cmi \
+ asmcomp/linear.cmi \
utils/identifiable.cmi
asmcomp/debug/compute_ranges_intf.cmx : \
utils/numbers.cmx \
- asmcomp/linearize.cmx \
+ asmcomp/linear.cmx \
utils/identifiable.cmx
asmcomp/debug/reg_availability_set.cmo : \
asmcomp/debug/reg_with_debug_info.cmi \
driver/main.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
- utils/misc.cmi \
driver/makedepend.cmi \
driver/main_args.cmi \
parsing/location.cmi \
driver/main.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
- utils/misc.cmx \
driver/makedepend.cmx \
driver/main_args.cmx \
parsing/location.cmx \
driver/main_args.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
+ utils/misc.cmi \
utils/config.cmi \
+ driver/compenv.cmi \
utils/clflags.cmi \
driver/main_args.cmi
driver/main_args.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
+ utils/misc.cmx \
utils/config.cmx \
+ driver/compenv.cmx \
utils/clflags.cmx \
driver/main_args.cmi
driver/main_args.cmi :
utils/config.cmi \
middle_end/compilenv.cmi \
driver/compile_common.cmi \
+ middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
asmcomp/asmgen.cmi \
driver/optcompile.cmi
utils/config.cmx \
middle_end/compilenv.cmx \
driver/compile_common.cmx \
+ middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
asmcomp/asmgen.cmx \
driver/optcompile.cmi
utils/warnings.cmi \
utils/profile.cmi \
asmcomp/proc.cmi \
- asmcomp/printmach.cmi \
driver/optcompile.cmi \
- utils/misc.cmi \
driver/makedepend.cmi \
driver/main_args.cmi \
parsing/location.cmi \
utils/warnings.cmx \
utils/profile.cmx \
asmcomp/proc.cmx \
- asmcomp/printmach.cmx \
driver/optcompile.cmx \
- utils/misc.cmx \
driver/makedepend.cmx \
driver/main_args.cmx \
parsing/location.cmx \
driver/compmisc.cmi \
middle_end/compilenv.cmi \
driver/compenv.cmi \
+ middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
typing/btype.cmi \
middle_end/backend_intf.cmi \
driver/compmisc.cmx \
middle_end/compilenv.cmx \
driver/compenv.cmx \
+ middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
typing/btype.cmx \
middle_end/backend_intf.cmi \
parsing/location.cmi \
typing/env.cmi
toplevel/opttopmain.cmo : \
- utils/warnings.cmi \
- asmcomp/printmach.cmi \
toplevel/opttoploop.cmi \
toplevel/opttopdirs.cmi \
utils/misc.cmi \
driver/main_args.cmi \
parsing/location.cmi \
driver/compmisc.cmi \
- driver/compenv.cmi \
utils/clflags.cmi \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmx : \
- utils/warnings.cmx \
- asmcomp/printmach.cmx \
toplevel/opttoploop.cmx \
toplevel/opttopdirs.cmx \
utils/misc.cmx \
driver/main_args.cmx \
parsing/location.cmx \
driver/compmisc.cmx \
- driver/compenv.cmx \
utils/clflags.cmx \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmi :
toplevel/opttopmain.cmx
toplevel/topdirs.cmo : \
utils/warnings.cmi \
- typing/typetexp.cmi \
typing/types.cmi \
toplevel/trace.cmi \
toplevel/toploop.cmi \
toplevel/topdirs.cmi
toplevel/topdirs.cmx : \
utils/warnings.cmx \
- typing/typetexp.cmx \
typing/types.cmx \
toplevel/trace.cmx \
toplevel/toploop.cmx \
parsing/location.cmi \
typing/env.cmi
toplevel/topmain.cmo : \
- utils/warnings.cmi \
toplevel/toploop.cmi \
toplevel/topdirs.cmi \
- utils/profile.cmi \
utils/misc.cmi \
driver/main_args.cmi \
parsing/location.cmi \
utils/clflags.cmi \
toplevel/topmain.cmi
toplevel/topmain.cmx : \
- utils/warnings.cmx \
toplevel/toploop.cmx \
toplevel/topdirs.cmx \
- utils/profile.cmx \
utils/misc.cmx \
driver/main_args.cmx \
parsing/location.cmx \
*.png binary
*.tfm binary
+/boot/menhir/parser.ml* -diff
+
# configure is declared as binary so that it doesn't get included in diffs.
# This also means it will have the correct Unix line-endings, even on Windows.
/configure binary
tools/markdown-add-pr-links.sh text eol=lf
runtime/caml/m.h.in text eol=lf
runtime/caml/s.h.in text eol=lf
+runtime/caml/compatibility.h typo.long-line=may
# These are all Perl scripts, so may not actually require this
manual/tools/caml-tex text eol=lf
# Tests which include references spanning multiple lines fail with \r\n
# endings, so use \n endings only, even on Windows.
+testsuite/tests/basic-modules/anonymous.ml text eol=lf
testsuite/tests/basic-more/morematch.ml text eol=lf
testsuite/tests/basic-more/robustmatch.ml text eol=lf
testsuite/tests/parsing/*.ml text eol=lf
/autom4te.cache
/ocamlc
/config.cache
+/ocaml-*.cache
/config.log
/config.status
/libtool
/boot/camlheader
/boot/ocamlc.opt
-/bytecomp/runtimedef.ml
/bytecomp/opcodes.ml
/bytecomp/opcodes.mli
/runtime/caml/m.h
/runtime/caml/s.h
/runtime/primitives
+/runtime/primitives.new
/runtime/prims.c
/runtime/caml/opnames.h
/runtime/caml/version.h
/runtime/.gdb_history
/runtime/*.d.c
/runtime/*.pic.c
+/runtime/domain_state32.inc
+/runtime/domain_state64.inc
/stdlib/camlheader
/stdlib/target_camlheader
/tools/primreq.opt
/tools/ocamldumpobj
/tools/keywords
-/tools/lexer299.ml
-/tools/ocaml299to3
/tools/ocamlmklib
/tools/ocamlmklib.opt
/tools/ocamlmklibconfig.ml
-/tools/lexer301.ml
-/tools/scrapelabels
-/tools/addlabels
/tools/objinfo_helper
/tools/read_cmt
/tools/read_cmt.opt
/tools/caml-tex
/utils/config.ml
+/utils/domainstate.ml
+/utils/domainstate.mli
/yacc/ocamlyacc
/yacc/version.h
language: c
git:
submodules: false
-script: bash -e tools/ci/travis/travis-ci.sh
+script: tools/ci/travis/travis-ci.sh
matrix:
include:
- - env: CI_KIND=build XARCH=i386
+ - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0
+ - env: CI_KIND=build XARCH=i386 CONFIG_ARG=--disable-stdlib-manpages
addons:
apt:
packages:
- libx11-dev:i386
- libc6-dev:i386
- env: CI_KIND=build XARCH=x64
- - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0
+ addons:
+ apt:
+ packages:
+ - texlive-latex-extra
+ - texlive-fonts-recommended
+ - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--disable-shared
+ - env: CI_KIND=build XARCH=x64 MIN_BUILD=1
- env: CI_KIND=changes
- env: CI_KIND=manual
- env: CI_KIND=check-typo
So: be prepared for some serious review process! But yes, yes,
contributions are welcome and appreciated. Promised.
+## Contributing optimizations
+
+Contributions to improve the compiler's optimization capabilities are
+welcome. However, due to the potential risks involved with such
+changes, we ask the following of contributors when submitting pull
+requests:
+
+ - Explain the benefits of the optimization (faster code, smaller
+ code, improved cache behaviour, lower power consumption, increased
+ compilation speed).
+
+ - Explain when the optimization does and does not apply.
+
+ - Explain when, if ever, the optimization may be detrimental.
+
+ - Provide benchmark measurements to justify the expected
+ benefits. Measurements should ideally include experiments with
+ full-scale applications as well as with microbenchmarks. Which
+ kinds of measurements are appropriate will vary depending on the
+ optimization; some optimizations may have to be measured indirectly
+ (for example, by measuring cache misses for a code size
+ optimization). Measurements showing clear benefits when combined
+ with some other optimization/change are acceptable.
+
+ - At least some of the measurements provided should be from
+ experiments on open source code.
+
+ - If assistance is sought with benchmarking then this should be made
+ clear on the initial pull request submission.
+
+ - Justify the correctness of the optimization, and discuss a testing
+ strategy to ensure that it does not introduce bugs. The use of
+ formal methods to increase confidence is encouraged.
+
+A major criterion in assessing whether to include an optimisation in
+the compiler is the balance between the increased complexity of the
+compiler code and the expected benefits of the benchmark. Contributors
+are asked to bear this in mind when making submissions.
## Contributor License Agreement
-OCaml 4.09.1 (16 Mars 2020):
-----------------------------
+OCaml 4.10.0 (21 February 2020)
+-------------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+### Language features
+
+- #7757, #1726: multi-indices for extended indexing operators:
+ `a.%{0;1;2}` desugars to `( .%{ ;.. } ) a [|0;1;2|]`
+ (Florian Angeletti, review by Gabriel Radanne)
+
+* #1859, #9117: enforce safe (immutable) strings by removing
+ the -unsafe-string option by default. This can be overridden by
+ a configure-time option (available since 4.04 in 2016):
+ --disable-force-safe-string since 4.08, -no-force-safe-since
+ between 4.07 and 4.04.
+ In the force-safe-string mode (now the default), the return type of the
+ String_val macro in C stubs is `const char*` instead of
+ `char*`. This change may break C FFI code.
+ (Kate Deplaix)
+
+
+- #6662, #8908: allow writing "module _ = E" to ignore module expressions
+ (Thomas Refis, review by Gabriel Radanne)
+
+### Runtime system:
+
+- #8809, #9292: Add a best-fit allocator for the major heap; still
+ experimental, it should be much better than current allocation
+ policies (first-fit and next-fit) for programs with large heaps,
+ reducing both GC cost and memory usage.
+ This new best-fit is not (yet) the default; set it explicitly with
+ OCAMLRUNPARAM="a=2" (or Gc.set from the program). You may also want
+ to increase the `space_overhead` parameter of the GC (a percentage,
+ 80 by default), for example OCAMLRUNPARAM="o=85", for optimal
+ speed.
+ (Damien Doligez, review by Stephen Dolan, Jacques-Henri Jourdan,
+ Xavier Leroy, Leo White)
+
+* #8713, #8940, #9115, #9143, #9202, #9251:
+ Introduce a state table in the runtime to contain the global variables.
+ (The Multicore runtime will have one such state for each domain.)
+
+ This changes the status of some internal variables of the OCaml runtime;
+ in many cases the header file originally defining the internal variable
+ provides a compatibility macro with the old name, but programs
+ re-defining those variables by hand need to be fixed.
+
+ (KC Sivaramakrishnan and Stephen Dolan,
+ compatibility hacking by David Allsopp, Florian Angeletti, Kate Deplaix,
+ Jacques Garrigue, Guillaume Munch-Maccagnoni and Nicolás Ojeda Bär,
+ review by David Allsopp, Alain Frisch, Nicolas Ojeda Bar,
+ Gabriel Scherer, Damien Doligez, and Guillaume Munch-Maccagnoni)
+
+- #8993: New C functions caml_process_pending_actions{,_exn} in
+ caml/signals.h, intended for executing all pending actions inside
+ long-running C functions (requested minor and major collections,
+ signal handlers, finalisers, and memprof callbacks). The function
+ caml_process_pending_actions_exn returns any exception arising
+ during their execution, allowing resources to be cleaned-up before
+ re-raising.
+ (Guillaume Munch-Maccagnoni, review by Jacques-Henri Jourdan,
+ Stephen Dolan, and Gabriel Scherer)
+
+* #8691, #8897, #9027: Allocation functions are now guaranteed not to
+ trigger any OCaml callback when called from C. In long-running C
+ functions, this can be replaced with calls to
+ caml_process_pending_actions at safe points.
+ Side effect of this change: in bytecode mode, polling for
+ asynchronous callbacks is performed at every minor heap allocation,
+ in addition to function calls and loops as in previous OCaml
+ releases.
+ (Jacques-Henri Jourdan, review by Stephen Dolan, Gabriel Scherer and
+ Guillaume Munch-Maccagnoni)
+
+* #9037: caml_check_urgent_gc is now guaranteed not to trigger any
+ finaliser. In long-running C functions, this can be replaced
+ with calls to caml_process_pending_actions at safe points.
+ (Guillaume Munch-Maccagnoni, review by Jacques-Henri Jourdan and
+ Stephen Dolan)
+
+
+- #8619: Ensure Gc.minor_words remains accurate after a GC.
+ (Stephen Dolan, Xavier Leroy and David Allsopp,
+ review by Xavier Leroy and Gabriel Scherer)
+
+- #8667: Limit GC credit to 1.0
+ (Leo White, review by Damien Doligez)
+
+- #8670: Fix stack overflow detection with systhreads
+ (Stephen Dolan, review by Xavier Leroy, Anil Madhavapeddy, Gabriel Scherer,
+ Frédéric Bour and Guillaume Munch-Maccagnoni)
+
+* #8711: The major GC hooks are no longer allowed to interact with the
+ OCaml heap.
+ (Jacques-Henri Jourdan, review by Damien Doligez)
+
+- #8630: Use abort() instead of exit(2) in caml_fatal_error, and add
+ the new hook caml_fatal_error_hook.
+ (Jacques-Henri Jourdan, review by Xavier Leroy)
+
+- #8641: Better call stacks when a C call is involved in byte code mode
+ (Jacques-Henri Jourdan, review by Xavier Leroy)
+
+- #8634, #8668, #8684, #9103 (originally #847): Statistical memory profiling.
+ In OCaml 4.10, support for allocations in the minor heap in native
+ mode is not available, and callbacks for promotions and
+ deallocations are not available.
+ Hence, there is not any public API for this feature yet.
+ (Jacques-Henri Jourdan, review by Stephen Dolan, Gabriel Scherer
+ and Damien Doligez)
+
+- #9268, #9271: Fix bytecode backtrace generation with large integers present.
+ (Stephen Dolan and Mark Shinwell, review by Gabriel Scherer and
+ Jacques-Henri Jourdan)
+
+### Standard library:
+
+- #8760: List.concat_map : ('a -> 'b list) -> 'a list -> 'b list
+ (Gabriel Scherer, review by Daniel Bünzli and Thomas Refis)
+
+- #8832: List.find_map : ('a -> 'b option) -> 'a list -> 'b option
+ (Gabriel Scherer, review by Jeremy Yallop, Nicolás Ojeda Bär
+ and Daniel Bünzli)
+
+- #7672, #1492: Add `Filename.quote_command` to produce properly-quoted
+ commands for execution by Sys.command.
+ (Xavier Leroy, review by David Allsopp and Damien Doligez)
+
+- #8971: Add `Filename.null`, the conventional name of the "null" device.
+ (Nicolás Ojeda Bär, review by Xavier Leroy and Alain Frisch)
+
+- #8651: add '%#F' modifier in printf to output OCaml float constants
+ in hexadecimal
+ (Pierre Roux, review by Gabriel Scherer and Xavier Leroy)
+
+
+- #8657: Optimization in [Array.make] when initializing with unboxed
+ or young values.
+ (Jacques-Henri Jourdan, review by Gabriel Scherer and Stephen Dolan)
+
+- #8716: Optimize [Array.fill] and [Hashtbl.clear] with a new runtime primitive
+ (Alain Frisch, review by David Allsopp, Stephen Dolan and Damien Doligez)
+
+- #8530: List.sort: avoid duplicate work by chop
+ (Guillaume Munch-Maccagnoni, review by David Allsopp, Damien Doligez and
+ Gabriel Scherer)
+
+### Other libraries:
+
+- #1939, #2023: Implement Unix.truncate and Unix.ftruncate on Windows.
+ (Florent Monnier and Nicolás Ojeda Bär, review by David Allsopp)
+
+### Code generation and optimizations:
+
+- #8806: Add an [@@immediate64] attribute for types that are known to
+ be immediate only on 64 bit platforms
+ (Jérémie Dimino, review by Vladimir Keleshev)
+
+- #9028, #9032: Fix miscompilation by no longer assuming that
+ untag_int (tag_int x) = x in Cmmgen; the compilation of `(n lsl 1) + 1`,
+ for example, would be incorrect if evaluated with a large value for `n`.
+ (Stephen Dolan, review by Vincent Laviron and Xavier Leroy)
+
+- #8672: Optimise Switch code generation on booleans.
+ (Stephen Dolan, review by Pierre Chambart)
+
+
+- #8990: amd64: Emit 32bit registers for Iconst_int when we can
+ (Xavier Clerc, Tom Kelly and Mark Shinwell, review by Xavier Leroy)
+
+- #2322: Add pseudo-instruction `Ladjust_trap_depth` to replace
+ dummy Lpushtrap generated in linearize
+ (Greta Yorsh and Vincent Laviron, review by Xavier Leroy)
+
+- #8707: Simplif: more regular treatment of Tupled and Curried functions
+ (Gabriel Scherer, review by Leo White and Alain Frisch)
+
+- #8526: Add compile-time option -function-sections in ocamlopt to emit
+ each function in a separate named text section on supported targets.
+ (Greta Yorsh, review by Pierre Chambart)
+
+- #2321: Eliminate dead ICatch handlers
+ (Greta Yorsh, review by Pierre Chambart and Vincent Laviron)
+
+- #8919: lift mutable lets along with immutable ones
+ (Leo White, review by Pierre Chambart)
+
+- #8909: Graph coloring register allocator: the weights put on
+ preference edges should not be divided by 2 in branches of
+ conditional constructs, because it is not good for performance
+ and because it leads to ignoring preference edges with 0 weight.
+ (Eric Stavarache, review by Xavier Leroy)
+
+- #9006: int32 code generation improvements
+ (Stephen Dolan, designed with Greta Yorsh, review by Xavier Clerc,
+ Xavier Leroy and Alain Frisch)
+
+- #9041: amd64: Avoid stall in sqrtsd by clearing destination.
+ (Stephen Dolan, with thanks to Andrew Hunter, Will Hasenplaugh,
+ Spiros Eliopoulos and Brian Nigito. Review by Xavier Leroy)
+
+- #2165: better unboxing heuristics for let-bound identifiers
+ (Alain Frisch, review by Vincent Laviron and Gabriel Scherer)
+
+- #8735: unbox across static handlers
+ (Alain Frisch, review by Vincent Laviron and Gabriel Scherer)
+
+### Manual and documentation:
+
+- #8718, #9089: syntactic highlighting for code examples in the manual
+ (Florian Angeletti, report by Anton Kochkov, review by Gabriel Scherer)
+
+- #9101: add links to section anchor before the section title,
+ make the name of those anchor explicits.
+ (Florian Angeletti, review by Daniel Bünzli, Sébastien Hinderer,
+ and Gabriel Scherer)
+
+- #9257, cautionary guidelines for using the internal runtime API
+ without too much updating pain.
+ (Florian Angeletti, review by Daniel Bünzli, Guillaume Munch-Maccagnoni
+ and KC Sivaramakrishnan)
+
+
+- #8950: move local opens in pattern out of the extension chapter
+ (Florian Angeletti, review and suggestion by Gabriel Scherer)
+
+- #9088, #9097: fix operator character classes
+ (Florian Angelettion, review by Gabriel Scherer,
+ report by Clément Busschaert)
+
+- #9169: better documentation for the best-fit allocation policy
+ (Gabriel Scherer, review by Guillaume Munch-Maccagnoni
+ and Florian Angeletti)
+
+### Compiler user-interface and warnings:
+
+- #8833: Hint for (type) redefinitions in toplevel session
+ (Florian Angeletti, review by Gabriel Scherer)
+
+- #2127, #9185: Refactor lookup functions
+ Included observable changes:
+ - makes the location of usage warnings and alerts for constructors more
+ precise
+ - don't warn about a constructor never being used to build values when it
+ has been defined as private
+ (Leo White, Hugo Heuzard review by Thomas Refis, Florian Angeletti)
+
+- #8702, #8777: improved error messages for fixed row polymorphic variants
+ (Florian Angeletti, report by Leo White, review by Thomas Refis)
+
+- #8844: Printing faulty constructors, inline records fields and their types
+ during type mismatches. Also slightly changed other type mismatches error
+ output.
+ (Mekhrubon Turaev, review by Florian Angeletti, Leo White)
+
+- #8885: Warn about unused local modules
+ (Thomas Refis, review by Alain Frisch)
+
+- #8872: Add ocamlc option "-output-complete-exe" to build a self-contained
+ binary for bytecode programs, containing the runtime and C stubs.
+ (Stéphane Glondu, Nicolás Ojeda Bär, review by Jérémie Dimino and Daniel
+ Bünzli)
+
+- #8874: add tests for typechecking error messages and pack them into
+ pretty-printing boxes.
+ (Oxana Kostikova, review by Gabriel Scherer)
+
+- #8891: Warn about unused functor parameters
+ (Thomas Refis, review by Gabriel Radanne)
+
+- #8903: Improve errors for first-class modules
+ (Leo White, review by Jacques Garrigue)
+
+- #8914: clarify the warning on unboxable types used in external primitives (61)
+ (Gabriel Scherer, review by Florian Angeletti, report on the Discourse forum)
+
+- #9046: disable warning 30 by default
+ This outdated warning complained on label/constructor name conflicts
+ within a mutually-recursive type declarations; there is now no need
+ to complain thanks to type-based disambiguation.
+ (Gabriel Scherer)
+
+### Tools:
+
+* #6792, #8654 ocamldebug now supports programs using Dynlink. This
+ changes ocamldebug messages, which may break compatibility
+ with older emacs modes.
+ (Whitequark and Jacques-Henri Jourdan, review by Gabriel Scherer
+ and Xavier Clerc)
+
+- #8621: Make ocamlyacc a Windows Unicode application
+ (David Allsopp, review by Nicolás Ojeda Bär)
+
+* #8834, `ocaml`: adhere to the XDG base directory specification to
+ locate an `.ocamlinit` file. Reads an `$XDG_CONFIG_HOME/ocaml/init.ml`
+ file before trying to lookup `~/.ocamlinit`. On Windows the behaviour
+ is unchanged.
+ (Daniel C. Bünzli, review by David Allsopp, Armaël Guéneau and
+ Nicolás Ojeda Bär)
+
+- #9113: ocamldoc: fix the rendering of multi-line code blocks
+ in the 'man' backend.
+ (Gabriel Scherer, review by Florian Angeletti)
+
+- #9127, #9130: ocamldoc: fix the formatting of closing brace in record types.
+ (David Allsopp, report by San Vu Ngoc)
+
+- #9181: make objinfo work on Cygwin and look for the caml_plugin_header
+ symbol in both the static and the dynamic symbol tables.
+ (Sébastien Hinderer, review by Gabriel Scherer and David Allsopp)
+
+### Build system:
+
+- #8840: use ocaml{c,opt}.opt when available to build internal tools
+ On my machine this reduces parallel-build times from 3m30s to 2m50s.
+ (Gabriel Scherer, review by Xavier Leroy and Sébastien Hinderer)
+
+- #8650: ensure that "make" variables are defined before use;
+ revise generation of config/util.ml to better quote special characters
+ (Xavier Leroy, review by David Allsopp)
+
+- #8690, #8696: avoid rebuilding the world when files containing primitives
+ change.
+ (Stephen Dolan, review by Gabriel Scherer, Sébastien Hinderer and
+ Thomas Refis)
+
+- #8835: new configure option --disable-stdlib-manpages to disable building
+ and installation of the library manpages.
+ (David Allsopp, review by Florian Angeletti and Gabriel Scherer)
+
+- #8837: build manpages using ocamldoc.opt when available
+ cuts the manpages build time from 14s to 4s
+ (Gabriel Scherer, review by David Allsopp and Sébastien Hinderer,
+ report by David Allsopp)
+
+- #8843, #8841: fix use of off_t on 32-bit systems.
+ (Stephen Dolan, report by Richard Jones, review by Xavier Leroy)
+
+- #8947, #9134, #9302, #9311: fix/improve support for the BFD library
+ (Sébastien Hinderer, review by Damien Doligez and David Allsopp)
+
+- #8951: let make's default target build the compiler
+ (Sébastien Hinderer, review by David Allsopp)
+
+- #8995: allow developers to specify frequently-used configure options in
+ Git (ocaml.configure option) and a directory for host-specific, shareable
+ config.cache files (ocaml.configure-cache option). See HACKING.adoc for
+ further details.
+ (David Allsopp, review by Gabriel Scherer)
+
+- #9136: Don't propagate Cygwin-style prefix from configure to
+ Makefile.config on Windows ports.
+ (David Allsopp, review by Sébastien Hinderer)
+
+### Internal/compiler-libs changes:
+
+- #8828: Added abstractions for variants, records, constructors, fields and
+ extension constructor types mismatch.
+ (Mekhrubon Turaev, review by Florian Angeletti, Leo White and Gabriel Scherer)
+
+- #7927, #8527: Replace long tuples into records in typeclass.ml
+ (Ulugbek Abdullaev, review by David Allsopp and Gabriel Scherer)
+
+- #1963: split cmmgen into generic Cmm helpers and clambda transformations
+ (Vincent Laviron, review by Mark Shinwell)
+
+- #1901: Fix lexing of character literals in comments
+ (Pieter Goetschalckx, review by Damien Doligez)
+
+- #1932: Allow octal escape sequences and identifiers containing apostrophes
+ in ocamlyacc actions and comments.
+ (Pieter Goetschalckx, review by Damien Doligez)
+
+- #2288: Move middle end code from [Asmgen] to [Clambda_middle_end] and
+ [Flambda_middle_end]. Run [Un_anf] from the middle end, not [Cmmgen].
+ (Mark Shinwell, review by Pierre Chambart)
+
+- #8692: Remove Misc.may_map and similar
+ (Leo White, review by Gabriel Scherer and Thomas Refis)
+
+- #8677: Use unsigned comparisons in amd64 and i386 emitter of Lcondbranch3.
+ (Greta Yorsh, review by Xavier Leroy)
+
+- #8766: Parmatch: introduce a type for simplified pattern heads
+ (Gabriel Scherer and Thomas Refis, review by Stephen Dolan and
+ Florian Angeletti)
+
+- #8774: New implementation of Env.make_copy_of_types
+ (Alain Frisch, review by Thomas Refis, Leo White and Jacques Garrigue)
+
+- #7924: Use a variant instead of an int in Bad_variance exception
+ (Rian Douglas, review by Gabriel Scherer)
+
+- #8890: in -dtimings output, show time spent in C linker clearly
+ (Valentin Gatien-Baron)
+
+- #8910, #8911: minor improvements to the printing of module types
+ (Gabriel Scherer, review by Florian Angeletti)
+
+- #8913: ocamltest: improve 'promote' implementation to take
+ skipped lines/bytes into account
+ (Gabriel Scherer, review by Sébastien Hinderer)
+
+- #8908: Use an option instead of a string for module names ("_" becomes None),
+ and a dedicated type for functor parameters: "()" maps to "Unit" (instead of
+ "*").
+ (Thomas Refis, review by Gabriel Radanne)
+
+- #8928: Move contains_calls and num_stack_slots from Proc to Mach.fundecl
+ (Greta Yorsh, review by Florian Angeletti and Vincent Laviron)
+
+- #8959, #8960, #8968, #9023: minor refactorings in the typing of patterns:
+ + refactor the {let,pat}_bound_idents* functions
+ + minor bugfix in type_pat
+ + refactor the generic pattern-traversal functions
+ in Typecore and Typedtree
+ + restrict the use of Need_backtrack
+ (Gabriel Scherer and Florian Angeletti,
+ review by Thomas Refis and Gabriel Scherer)
+
+- #9030: clarify and document the parameter space of type_pat
+ (Gabriel Scherer and Florian Angeletti and Jacques Garrigue,
+ review by Florian Angeletti and Thomas Refis)
+
+- #8975: "ocamltests" files are no longer required or used by
+ "ocamltest". Instead, any text file in the testsuite directory containing a
+ valid "TEST" block will be automatically included in the testsuite.
+ (Nicolás Ojeda Bär, review by Gabriel Scherer and Sébastien Hinderer)
+
+- #8992: share argument implementations between executables
+ (Florian Angeletti, review by Gabriel Scherer)
+
+- #9015: fix fatal error in pprint_ast (#8789)
+ (Damien Doligez, review by ...)
+
+### Bug fixes:
+
+- #5673, #7636: unused type variable causes generalization error
+ (Jacques Garrigue and Leo White, review by Leo White,
+ reports by Jean-Louis Giavitto and Christophe Raffalli)
+
+- #6922, #8955: Fix regression with -principal type inference for inherited
+ methods, allowing to compile ocamldoc with -principal
+ (Jacques Garrigue, review by Leo White)
+
+- #7925, #8611: fix error highlighting for exceptionally
+ long toplevel phrases
+ (Kyle Miller, reported by Armaël Guéneau, review by Armaël Guéneau
+ and Nicolás Ojeda Bär)
+
+- #8622: Don't generate #! headers over 127 characters.
+ (David Allsopp, review by Xavier Leroy and Stephen Dolan)
+
+- #8715: minor bugfixes in CamlinternalFormat; removes the unused
+ and misleading function CamlinternalFormat.string_of_formatting_gen
+ (Gabriel Scherer and Florian Angeletti,
+ review by Florian Angeletti and Gabriel Radanne)
+
+- #8792, #9018: Possible (latent) bug in Ctype.normalize_type
+ removed incrimined Btype.log_type, replaced by Btype.set_type
+ (Jacques Garrigue, report by Alain Frisch, review by Thomas Refis)
+
+- #8856, #8860: avoid stackoverflow when printing cyclic type expressions
+ in some error submessages.
+ (Florian Angeletti, report by Mekhrubon Turaev, review by Leo White)
+
+- #8875: fix missing newlines in the output from MSVC invocation.
+ (Nicolás Ojeda Bär, review by Gabriel Scherer)
+
+- #8921, #8924: Fix stack overflow with Flambda
+ (Vincent Laviron, review by Pierre Chambart and Leo White,
+ report by Aleksandr Kuzmenko)
+
+- #8892, #8895: fix the definition of Is_young when CAML_INTERNALS is not
+ defined.
+ (David Allsopp, review by Xavier Leroy)
+
+- #8896: deprecate addr typedef in misc.h
+ (David Allsopp, suggestion by Xavier Leroy)
+
+- #8981: Fix check for incompatible -c and -o options.
+ (Greta Yorsh, review by Damien Doligez)
+
+- #9019, #9154: Unsound exhaustivity of GADTs from incomplete unification
+ Also fixes bug found by Thomas Refis in #9012
+ (Jacques Garrigue, report and review by Leo White, Thomas Refis)
+
+- #9031: Unregister Windows stack overflow handler while shutting
+ the runtime down.
+ (Dmitry Bely, review by David Allsopp)
+
+- #9051: fix unregistered local root in win32unix/select.c (could result in
+ `select` returning file_descr-like values which weren't in the original sets)
+ and correct initialisation of some blocks allocated with caml_alloc_small.
+ (David Allsopp, review by Xavier Leroy)
+
+- #9073, #9120: fix incorrect GC ratio multiplier when allocating custom blocks
+ with caml_alloc_custom_mem in runtime/custom.c
+ (Markus Mottl, review by Gabriel Scherer and Damien Doligez)
+
+- #9209, #9212: fix a development-version regression caused by #2288
+ (Kate Deplaix and David Allsopp, review by Sébastien Hinderer
+ and Gabriel Scherer )
+
+- #9218, #9269: avoid a rare wrong module name error with "-annot" and
+ inline records.
+ (Florian Angeletti, review by Gabriel Scherer, report by Kate Deplaix)
+
+- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908)
+ (Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer)
+
+OCaml 4.09 maintenance branch:
+------------------------------
- #8855, #8858: Links for tools not created when installing with
--disable-installing-byecode-programs (e.g. ocamldep.opt installed, but
ocamldep link not created)
(David Allsopp, report by Thomas Leonard)
-- #8947, #9134, #9302: fix/improve support for the BFD library
- (Sébastien Hinderer, review by Damien Doligez and David Allsopp)
-
- #8953, #8954: Fix error submessages in the toplevel: do not display
dummy locations
(Armaël Guéneau, review by Gabriel Scherer)
- #9050, #9076: install missing compilerlibs/ocamlmiddleend archives
(Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering)
-- #9073, #9120: fix incorrect GC ratio multiplier when allocating custom blocks
- with caml_alloc_custom_mem in runtime/custom.c
- (Markus Mottl, review by Gabriel Scherer and Damien Doligez)
-
-- #9144, #9180: multiple definitions of global variables in the C runtime,
- causing problems with GCC 10.0 and possibly with other C compilers
- (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell)
-
- #9180: pass -fno-common option to C compiler when available,
so as to detect problematic multiple definitions of global variables
in the C runtime
(Xavier Leroy, review by Mark Shinwell)
+- #9144, #9180: multiple definitions of global variables in the C runtime,
+ causing problems with GCC 10.0 and possibly with other C compilers
+ (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell)
+
- #9128: Fix a bug in bytecode mode which could lead to a segmentation
fault. The bug was caused by the fact that the atom table shared a
page with some bytecode. The fix makes sure both the atom table and
OCaml 4.09.0 (19 September 2019):
---------------------------------
-(Changes that can break existing programs are marked with a "*")
-
### Runtime system:
* #1725, #2279: Deprecate Obj.set_tag and Obj.truncate
fixes an imenu crash.
(Wilfred Hughes, review by Christophe Troestler)
-- #1711: the new 'open' flag in OCAMLRUNPARAM takes a comma-separated list of
+- #1711: the new 'open' flag in OCAMLPARAM takes a comma-separated list of
modules to open as if they had been passed via the command line -open flag.
(Nicolás Ojeda Bär, review by Mark Shinwell)
float comparisons.
Standard library:
-- Format: new function ikfprintf analoguous to ifprintf with a continuation
+- Format: new function ikfprintf analogous to ifprintf with a continuation
argument.
* #4210, #4245: stricter range checking in string->integer conversion
functions (int_of_string, Int32.of_string, Int64.of_string,
+
----
./configure
-make world.opt
+make
----
3. Try the newly built compiler binaries `ocamlc`, `ocamlopt` or their
These targets are automatically available when working in a Git clone of the
repository, but are not available from a tarball.
+=== Automatic configure options
+
+If you have options to `configure` which you always (or at least frequently)
+use, it's possible to store them in Git, and `configure` will automatically add
+them. For example, you may wish to avoid building the debug runtime by default
+while developing, in which case you can issue
+`git config --global ocaml.configure '--disable-debug-runtime'`. The `configure`
+script will alert you that it has picked up this option and added it _before_
+any options you specified for `configure`.
+
+Options are added before those passed on the command line, so it's possible to
+override them, for example `./configure --enable-debug-runtime` will build the
+debug runtime, since the enable flag appears after the disable flag. You can
+also use the full power of Git's `config` command and have options specific to
+particular clone or worktree.
+
+=== Speeding up configure
+
+`configure` includes the standard `-C` option which caches various test results
+in the file `config.cache` and can use those results to avoid running tests in
+subsequent invocations. This mechanism works fine, except that it is easy to
+clean the cache by mistake (e.g. with `git clean -dfX`). The cache is also
+host-specific which means the file has to be deleted if you run `configure` with
+a new `--host` value (this is quite common on Windows, where `configure` is
+also quite slow to run).
+
+You can elect to have host-specific cache files by issuing
+`git config --global ocaml.configure-cache .`. The `configure` script will now
+automatically create `ocaml-host.cache` (e.g. `ocaml-x86_64-pc-windows.cache`,
+or `ocaml-default.cache`). If you work with multiple worktrees, you can share
+these cache files by issuing `git config --global ocaml.configure-cache ..`. The
+directory is interpreted _relative_ to the `configure` script.
+
=== Bootstrapping
The OCaml compiler is bootstrapped. This means that
From the top directory, do:
- make world.opt
-+
-if your platform is supported by the native-code compiler (as reported during
- the auto-configuration), or
-
- make world
-+
-if not.
+ make
-This builds the OCaml bytecode compiler for the first time. This phase is
+This builds the OCaml compiler for the first time. This phase is
fairly verbose; consider redirecting the output to a file:
- make world > log.world 2>&1 # in sh
- make world >& log.world # in csh
+ make > make.log 2>&1 # in sh
+ make >& make.log # in csh
== (Optional) Running the testsuite
optimizing compilers. Alternatively, try another C compiler (e.g. `gcc` instead
of the vendor-supplied `cc`).
-You can also build a debug version of the runtime system. Go to the `runtime/`
-directory and do `make ocamlrund`. Then, copy `ocamlrund` to
-`../boot/ocamlrun`, and try again. This version of the runtime system contains
-lots of assertions and sanity checks that could help you pinpoint the problem.
-
+You can also use the debug version of the runtime system which is
+normally built and installed by default. Run the bytecode program
+that causes troubles with `ocamlrund` rather than with `ocamlrun`.
+This version of the runtime system contains lots of assertions
+and sanity checks that could help you pinpoint the problem.
== Common problems
include Makefile.config
include Makefile.common
-# For users who don't read the INSTALL file
.PHONY: defaultentry
-defaultentry:
-ifeq "$(UNIX_OR_WIN32)" "unix"
- @echo "Please refer to the installation instructions in file INSTALL."
- @echo "If you've just unpacked the distribution, something like"
- @echo " ./configure"
- @echo " make world.opt"
- @echo " make install"
- @echo "should work. But see the file INSTALL for more details."
+ifeq "$(NATIVE_COMPILER)" "true"
+defaultentry: world.opt
else
- @echo "Please refer to the instructions in file README.win32.adoc."
+defaultentry: world
endif
MKDIR=mkdir -p
COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \
-warn-error A \
-bin-annot -safe-string -strict-formats $(INCLUDES)
+ifeq "$(FUNCTION_SECTIONS)" "true"
+OPTCOMPFLAGS= -function-sections
+else
+OPTCOMPFLAGS=
+endif
LINKFLAGS=
ifeq "$(strip $(NATDYNLINKOPTS))" ""
OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt)
UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \
- utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \
- utils/clflags.cmo utils/profile.cmo \
- utils/load_path.cmo \
- utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
- utils/consistbl.cmo \
- utils/strongly_connected_components.cmo \
- utils/targetint.cmo \
- utils/int_replace_polymorphic_compare.cmo
+ utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \
+ utils/clflags.cmo utils/profile.cmo utils/load_path.cmo \
+ utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
+ utils/consistbl.cmo utils/strongly_connected_components.cmo \
+ utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \
+ utils/domainstate.cmo
PARSING=parsing/location.cmo parsing/longident.cmo \
parsing/docstrings.cmo parsing/syntaxerr.cmo \
parsing/builtin_attributes.cmo parsing/ast_invariants.cmo parsing/depend.cmo
TYPING=typing/ident.cmo typing/path.cmo \
- typing/primitive.cmo typing/types.cmo \
+ typing/primitive.cmo typing/type_immediacy.cmo typing/types.cmo \
typing/btype.cmo typing/oprint.cmo \
typing/subst.cmo typing/predef.cmo \
typing/datarepr.cmo file_formats/cmi_format.cmo \
bytecomp/meta.cmo bytecomp/opcodes.cmo \
bytecomp/bytesections.cmo bytecomp/dll.cmo \
bytecomp/symtable.cmo \
- driver/pparse.cmo driver/main_args.cmo \
- driver/compenv.cmo driver/compmisc.cmo \
+ driver/pparse.cmo driver/compenv.cmo \
+ driver/main_args.cmo driver/compmisc.cmo \
driver/makedepend.cmo \
driver/compile_common.cmo
asmcomp/afl_instrument.cmo \
asmcomp/strmatch.cmo \
asmcomp/cmmgen_state.cmo \
+ asmcomp/cmm_helpers.cmo \
asmcomp/cmmgen.cmo \
asmcomp/interval.cmo \
asmcomp/printmach.cmo asmcomp/selectgen.cmo \
asmcomp/linscan.cmo \
asmcomp/reloadgen.cmo asmcomp/reload.cmo \
asmcomp/deadcode.cmo \
- asmcomp/printlinear.cmo asmcomp/linearize.cmo \
+ asmcomp/linear.cmo asmcomp/printlinear.cmo asmcomp/linearize.cmo \
asmcomp/debug/available_regs.cmo \
asmcomp/debug/compute_ranges_intf.cmo \
asmcomp/debug/compute_ranges.cmo \
# the native code compiler is not present for some particular target.
MIDDLE_END_CLOSURE=\
- middle_end/closure/closure.cmo
+ middle_end/closure/closure.cmo \
+ middle_end/closure/closure_middle_end.cmo
# Owing to dependencies through [Compilenv], which would be
# difficult to remove, some of the lower parts of Flambda (anything that is
# The configuration file
-utils/config.ml: utils/config.mlp Makefile.config utils/Makefile Makefile
+utils/config.ml: utils/config.mlp Makefile.config utils/Makefile
$(MAKE) -C utils config.ml
.PHONY: reconfigure
reconfigure:
- ./configure $(CONFIGURE_ARGS)
+ ac_read_git_config=true ./configure $(CONFIGURE_ARGS)
+
+utils/domainstate.ml: utils/domainstate.ml.c runtime/caml/domain_state.tbl
+ $(CPP) -I runtime/caml $< > $@
+
+utils/domainstate.mli: utils/domainstate.mli.c runtime/caml/domain_state.tbl
+ $(CPP) -I runtime/caml $< > $@
.PHONY: partialclean
partialclean::
- rm -f utils/config.ml
+ rm -f utils/config.ml utils/domainstate.ml utils/domainstate.mli
.PHONY: beforedepend
-beforedepend:: utils/config.ml
+beforedepend:: utils/config.ml utils/domainstate.ml utils/domainstate.mli
# Start up the system from the distribution compiler
.PHONY: coldstart
$(MAKE) libraryopt
.PHONY: opt
-opt:
+opt: checknative
$(MAKE) runtimeopt
$(MAKE) ocamlopt
$(MAKE) libraryopt
# Native-code versions of the tools
.PHONY: opt.opt
-opt.opt:
+opt.opt: checknative
$(MAKE) checkstack
$(MAKE) runtime
$(MAKE) core
$(MAKE) otherlibrariesopt
$(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT) \
ocamltest.opt
+ifneq "$(WITH_OCAMLDOC)" ""
+ $(MAKE) manpages
+endif
# Core bootstrapping cycle
.PHONY: coreboot
all: coreall
$(MAKE) ocaml
$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) ocamltest
+ifneq "$(WITH_OCAMLDOC)" ""
+ $(MAKE) manpages
+endif
# Bootstrap and rebuild the whole system.
# The compilation of ocaml will fail if the runtime has changed.
# Compile also native code compiler and libraries, fast
.PHONY: world.opt
-world.opt: coldstart
+world.opt: checknative
+ $(MAKE) coldstart
$(MAKE) opt.opt
# FlexDLL sources missing error messages
# from an previous installation of OCaml before otherlibs/num was removed.
rm -f "$(INSTALL_LIBDIR)"/num.cm?
# End transitional
- if test -n "$(WITH_OCAMLDOC)"; then \
- $(MAKE) -C ocamldoc install; \
- fi
+ifneq "$(WITH_OCAMLDOC)" ""
+ $(MAKE) -C ocamldoc install
+endif
if test -n "$(WITH_DEBUGGER)"; then \
$(MAKE) -C debugger install; \
fi
$(INSTALL_DATA) \
$(OPTSTART) \
"$(INSTALL_COMPLIBDIR)"
- if test -n "$(WITH_OCAMLDOC)"; then \
- $(MAKE) -C ocamldoc installopt; \
- fi
+ifneq "$(WITH_OCAMLDOC)" ""
+ $(MAKE) -C ocamldoc installopt
+endif
for i in $(OTHERLIBRARIES); do \
$(MAKE) -C otherlibs/$$i installopt || exit $$?; \
done
# The lexer
parsing/lexer.ml: parsing/lexer.mll
- $(CAMLLEX) $<
+ $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
partialclean::
rm -f parsing/lexer.ml
# The lexer and parser generators
.PHONY: ocamllex
-ocamllex: ocamlyacc ocamlc
+ocamllex: ocamlyacc
$(MAKE) -C lex all
.PHONY: ocamllex.opt
parsing/camlinternalMenhirLib.ml: boot/menhir/menhirLib.ml
cp $< $@
parsing/camlinternalMenhirLib.mli: boot/menhir/menhirLib.mli
- cp $< $@
+ echo '[@@@ocaml.warning "-67"]' > $@
+ cat $< >> $@
# Copy parsing/parser.ml from boot/
parsing/parser.mli: boot/menhir/parser.mli
sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@
+beforedepend:: parsing/camlinternalMenhirLib.ml \
+ parsing/camlinternalMenhirLib.mli \
+ parsing/parser.ml parsing/parser.mli
partialclean:: partialclean-menhir
# OCamltest
ocamltest: ocamlc ocamlyacc ocamllex
- $(MAKE) -C ocamltest
+ $(MAKE) -C ocamltest all
ocamltest.opt: ocamlc.opt ocamlyacc ocamllex
- $(MAKE) -C ocamltest ocamltest.opt$(EXE)
+ $(MAKE) -C ocamltest allopt
partialclean::
$(MAKE) -C ocamltest clean
$(MAKE) -C ocamldoc $@
@echo "documentation is in ./ocamldoc/stdlib_html/"
+.PHONY: manpages
+manpages:
+ $(MAKE) -C ocamldoc $@
+
partialclean::
$(MAKE) -C ocamldoc clean
partialclean::
$(MAKE) -C debugger clean
+# Check that the native-code compiler is supported
+.PHONY: checknative
+checknative:
+ifeq "$(ARCH)" "none"
+checknative:
+ $(error The native-code compiler is not supported on this platform)
+else
+ @
+endif
+
# Check that the stack limit is reasonable (Unix-only)
.PHONY: checkstack
checkstack:
$(CAMLC) $(COMPFLAGS) -c $<
.ml.cmx:
- $(CAMLOPT) $(COMPFLAGS) -c $<
+ $(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $<
partialclean::
for d in utils parsing typing bytecomp asmcomp middle_end file_formats \
rm -f testsuite/_log*
include .depend
+
+Makefile.config Makefile.common:
+ @echo "Please refer to the installation instructions:"
+ @echo "- In file INSTALL for Unix systems."
+ @echo "- In file README.win32.adoc for Windows systems."
+ @echo "On Unix systems, if you've just unpacked the distribution,"
+ @echo "something like"
+ @echo " ./configure"
+ @echo " make"
+ @echo " make install"
+ @echo "should work."
+ @false
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Gabriel Scherer, projet Parsifal, INRIA Saclay *
+#* *
+#* Copyright 2019 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This Makefile should be included.
+
+# It expects:
+# - Makefile.common to be included as well
+# - a ROOTDIR variable pointing to the repository root
+# relative to the including Makefile
+
+# It exports definitions of BEST_OCAML{C,OPT,LEX,DEP} commands that
+# run to either the bytecode binary built in the repository or the
+# native binary, if available. Note that they never use the boot/
+# versions: we assume that ocamlc, ocamlopt, etc. have been run first.
+
+check_not_stale = \
+ $(if $(shell test $(ROOTDIR)/$1 -nt $(ROOTDIR)/$2 && echo stale), \
+ $(info Warning: we are not using the native binary $2 \
+because it is older than the bytecode binary $1; \
+you should silence this warning by either removing $2 \
+or rebuilding it (or `touch`-ing it) if you want it used.), \
+ ok)
+
+choose_best = $(strip $(if \
+ $(and $(wildcard $(ROOTDIR)/$1.opt),$(strip \
+ $(call check_not_stale,$1,$1.opt))), \
+ $(ROOTDIR)/$1.opt, \
+ $(CAMLRUN) $(ROOTDIR)/$1))
+
+BEST_OCAMLC := $(call choose_best,ocamlc)
+BEST_OCAMLOPT := $(call choose_best,ocamlopt)
+BEST_OCAMLLEX := $(call choose_best,lex/ocamllex)
+
+BEST_OCAMLDEP := $(BEST_OCAMLC) -depend
+# @configure_input@
+
#**************************************************************************
#* *
#* OCaml *
#* *
#**************************************************************************
-# This makefile contains common definitions shared by other Makefiles
+# This makefile contains common definitions and rules shared by
+# other Makefiles
# We assume that Makefile.config has already been included
INSTALL ?= @INSTALL@
# as some parts of the makefiles change BINDIR, etc.
# and expect INSTALL_BINDIR, etc. to stay in synch
# (see `shellquote` in tools/Makefile)
+DESTDIR ?=
INSTALL_BINDIR = $(DESTDIR)$(BINDIR)
INSTALL_LIBDIR = $(DESTDIR)$(LIBDIR)
INSTALL_STUBLIBDIR = $(DESTDIR)$(STUBLIBDIR)
ocamlopt_cmd = $(FLEXLINK_ENV) $(ocamlopt)
endif
+# By default, request ocamllex to be quiet
+OCAMLLEX_FLAGS ?= -q
+
# The rule to compile C files
# This rule is similar to GNU make's implicit rule, except that it is more
### Beware: on some systems (e.g. SunOS 4), this will work only if
### the string "#!$(BINDIR)/ocamlrun" is less than 32 characters long.
### In doubt, set HASHBANGSCRIPTS to false.
-HASHBANGSCRIPTS=@hashbangscripts@
+SHEBANGSCRIPTS=@shebangscripts@
+LONG_SHEBANG=@long_shebang@
+# For compatibility
+HASHBANGSCRIPTS:=$(SHEBANGSCRIPTS)
### Path to the libtool script
LIBTOOL = $(TOP_BUILDDIR)/libtool
############# Configuration for the native-code compiler
+### Whether the native compiler has been enabled or not
+NATIVE_COMPILER=@native_compiler@
+
### Name of architecture for the native-code compiler
### Currently supported:
###
AFL_INSTRUMENT=@afl@
MAX_TESTSUITE_DIR_RETRIES=@max_testsuite_dir_retries@
FLAT_FLOAT_ARRAY=@flat_float_array@
+FUNCTION_SECTIONS=@function_sections@
AWK=@AWK@
+STDLIB_MANPAGES=@stdlib_manpages@
### Native command to build ocamlrun.exe
# in the future their definition may be moved to a more private part of
# the compiler's build system
ifeq "$(UNIX_OR_WIN32)" "win32"
- DISTRIB=$(prefix)
OTOPDIR=$(WINTOPDIR)
CTOPDIR=$(WINTOPDIR)
CYGPATH=cygpath -m
# (see ocamlmklibconfig.ml in tools/Makefile)
FLEXLINK_FLAGS=@flexlink_flags@
FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS)
+else # ifeq "$(UNIX_OR_WIN32)" "win32"
+ # On Unix, make sure FLEXLINK is defined but empty
+ FLEXLINK =
endif # ifeq "$(UNIX_OR_WIN32)" "win32"
@for f in $(AST_FILES); do echo "'$$f'"; done
partialclean::
- rm -f $(AST_FILES)
+ @rm -f $(AST_FILES)
# This makefile provides variables for using the in-tree compiler,
# interpreter, lexer and other associated tools. It is intended to be
# included within other makefiles.
-# See testsuite/makefiles/Makefile.common, manual/tools/Makefile and
-# manual/manual/tutorials/Makefile as examples.
+# See manual/tools/Makefile and manual/manual/tutorials/Makefile as examples.
# Note that these makefile should define the $(TOPDIR) variable on their
# own.
include $(TOPDIR)/Makefile.config
+# Make sure USE_RUNTIME is defined
+USE_RUNTIME ?=
+
ifneq ($(USE_RUNTIME),)
#Check USE_RUNTIME value
ifeq ($(findstring $(USE_RUNTIME),d i),)
OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE)
DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj
OBJINFO=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlobjinfo
-BYTECODE_ONLY=[ "$(ARCH)" = "none" -o "$(ASM)" = "none" ]
-NATIVECODE_ONLY=false
#FORTRAN_COMPILER=
#FORTRAN_LIBRARY=
- Instrumentation support for fuzzing with afl-fuzz.
(GPR#504, by Stephen Dolan)
-- The compilers now accept new `-args/-args0 <file>` comand-line
+- The compilers now accept new `-args/-args0 <file>` command-line
parameters to provide extra command-line arguments in a file. User
programs may implement similar options using the new `Expand`
constructor of the `Arg` module.
eval $(tools/msvs-promote-path)
-If you forget to do this, `make world.opt` will fail relatively
+If you forget to do this, `make` will fail relatively
quickly as it will be unable to link `ocamlrun`.
Now run:
./configure --build=x86_64-unknown-cygwin --host=x86_64-pc-windows
-for 64-bit. Then, edit `Makefile.config` as needed, following the comments in
-this file. Normally, the only variable that needs to be changed is `PREFIX`,
-which indicates where to install everything.
+for 64-bit.
Finally, use `make` to build the system, e.g.
- make world.opt
+ make
make install
After installing, it is not necessary to keep the Cygwin installation (although
./configure --build=x86_64-unknown-cygwin --host=x86_64-w64-mingw32
-for 64-bit. Then, edit `Makefile.config` as needed, following the comments in
-this file. Normally, the only variable that needs to be changed is `PREFIX`,
-which indicates where to install everything.
+for 64-bit.
Finally, use `make` to build the system, e.g.
- make world.opt
+ make
make install
After installing, you will need to ensure that `ocamlopt` (or `ocamlc -custom`)
git submodule update --init
OCaml is then compiled as normal for the port you require, except that before
-compiling `world`, you must compile `flexdll`, i.e.:
+building the compiler itself, you must compile `flexdll`, i.e.:
make flexdll
- make world.opt
+ make
make flexlink.opt
make install
-4.09.1
+4.10.0
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
CFLAGS="$saved_CFLAGS"
])
+AC_DEFUN([OCAML_CC_SUPPORTS_ALIGNED], [
+ AC_MSG_CHECKING([whether the C compiler supports __attribute__((aligned(n)))])
+ AC_COMPILE_IFELSE(
+ [AC_LANG_SOURCE([typedef struct {__attribute__((aligned(8))) int t;} t;])],
+ [AC_DEFINE([SUPPORTS_ALIGNED_ATTRIBUTE])
+ AC_MSG_RESULT([yes])],
+ [AC_MSG_RESULT([no])])])
+
AC_DEFUN([OCAML_CC_HAS_DEBUG_PREFIX_MAP], [
AC_MSG_CHECKING([whether the C compiler supports -fdebug-prefix-map])
saved_CFLAGS="$CFLAGS"
match op with
| Ispecific spec ->
begin match spec with
- | Ilea _ | Isextend32 -> Op_pure
+ | Ilea _ | Isextend32 | Izextend32 -> Op_pure
| Istore_int(_, _, is_asg) -> Op_store is_asg
| Ioffset_loc(_, _) -> Op_store true
| Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load
| Ifloatsqrtf of addressing_mode (* Float square root from memory *)
| Isextend32 (* 32 to 64 bit conversion with sign
extension *)
+ | Izextend32 (* 32 to 64 bit conversion with zero
+ extension *)
+
and float_operation =
Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv
fprintf ppf "bswap_%i %a" i printreg arg.(0)
| Isextend32 ->
fprintf ppf "sextend32 %a" printreg arg.(0)
+ | Izextend32 ->
+ fprintf ppf "zextend32 %a" printreg arg.(0)
let win64 =
match Config.system with
open Proc
open Reg
open Mach
-open Linearize
+open Linear
open Emitaux
open X86_ast
let fastcode_flag = ref true
+(* Layout of the stack frame *)
let stack_offset = ref 0
-(* Layout of the stack frame *)
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let frame_required = ref false
let frame_size () = (* includes return address *)
- if frame_required() then begin
+ if !frame_required then begin
let sz =
(!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8
+ (if fp then 8 else 0))
else
I.mov (sym (emit_symbol s)) arg
+let domain_field f =
+ mem64 QWORD (Domainstate.idx_of_field f * 8) R14
+
(* Output a label *)
let emit_label lbl =
(* Record calls to the GC -- we've moved them out of the way *)
type gc_call =
- { gc_lbl: label; (* Entry label *)
+ { gc_size: int; (* Allocation size, in bytes *)
+ gc_lbl: label; (* Entry label *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame: label; (* Label of frame descriptor *)
gc_spacetime : (X86_ast.arg * int) option;
assert Config.spacetime;
spacetime_before_uninstrumented_call ~node_ptr ~index
end;
- emit_call "caml_call_gc";
+ begin match gc.gc_size with
+ | 16 -> emit_call "caml_call_gc1"
+ | 24 -> emit_call "caml_call_gc2"
+ | 32 -> emit_call "caml_call_gc3"
+ | n -> I.add (int n) r15;
+ emit_call "caml_call_gc"
+ end;
def_label gc.gc_frame;
I.jmp (label gc.gc_return_lbl)
(* Deallocate the stack frame before a return or tail call *)
let output_epilogue f =
- if frame_required() then begin
+ if !frame_required then begin
let n = frame_size() - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
D.global lbl;
_label lbl
+(* Output .text section directive, or named .text.caml.<name> if enabled and
+ supported on the target system. *)
+
+let emit_named_text_section func_name =
+ if !Clflags.function_sections then
+ begin match system with
+ | S_macosx
+ (* Names of section segments in macosx are restricted to 16 characters,
+ but function names are often longer, especially anonymous functions. *)
+ | S_win64 | S_mingw64 | S_cygwin
+ (* Win systems provide named text sections, but configure on these
+ systems does not support function sections. *)
+ -> assert false
+ | _ -> D.section
+ [ ".text.caml."^(emit_symbol func_name) ]
+ (Some "ax")
+ ["@progbits"]
+ end
+ else D.text ()
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (Proc.prologue_required ());
+ assert (!prologue_required);
if fp then begin
I.push rbp;
cfi_adjust_cfa_offset 8;
I.mov rsp rbp;
end;
- if frame_required() then begin
+ if !frame_required then begin
let n = frame_size() - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
| Lop(Iconst_int n) ->
if n = 0n then begin
match i.res.(0).loc with
- | Reg _ -> I.xor (res i 0) (res i 0)
- | _ -> I.mov (int 0) (res i 0)
- end
- else
+ | Reg _ ->
+ (* Clearing the bottom half also clears the top half (except for
+ 64-bit-only registers where the behaviour is as if the operands
+ were 64 bit). *)
+ I.xor (res32 i 0) (res32 i 0)
+ | _ ->
+ I.mov (int 0) (res i 0)
+ end else if n > 0n && n <= 0xFFFF_FFFFn then begin
+ match i.res.(0).loc with
+ | Reg _ ->
+ (* Similarly, setting only the bottom half clears the top half. *)
+ I.mov (nat n) (res32 i 0)
+ | _ ->
+ I.mov (nat n) (res i 0)
+ end else
I.mov (nat n) (res i 0)
| Lop(Iconst_float f) ->
begin match f with
If we do the same for Win64, we probably need to change
amd64nt.asm accordingly.
*)
- load_symbol_addr "caml_young_ptr" r11;
- I.mov (mem64 QWORD 0 R11) r15
+ I.mov (domain_field Domainstate.Domain_young_ptr) r15
end
end else begin
emit_call func;
let lbl_redo = new_label() in
def_label lbl_redo;
I.sub (int n) r15;
- let spacetime_node_hole_ptr_is_in_rax =
- Config.spacetime && (i.arg.(0).loc = Reg 0)
- in
- if !Clflags.dlcode then begin
- (* When using Spacetime, %rax might be the node pointer, so we
- must take care not to clobber it. (Whilst we can tell the
- register allocator that %rax is destroyed by Ialloc, we can't
- force that the argument (the node pointer) is not in %rax.) *)
- if spacetime_node_hole_ptr_is_in_rax then begin
- I.push rax
- end;
- load_symbol_addr "caml_young_limit" rax;
- I.cmp (mem64 QWORD 0 RAX) r15;
- if spacetime_node_hole_ptr_is_in_rax then begin
- I.pop rax (* this does not affect the flags *)
- end
- end else
- I.cmp (mem64_rip QWORD (emit_symbol "caml_young_limit")) r15;
+ I.cmp (domain_field Domainstate.Domain_young_limit) r15;
let lbl_call_gc = new_label() in
let dbg =
if not Config.spacetime then Debuginfo.none
else Some (arg i 0, spacetime_index)
in
call_gc_sites :=
- { gc_lbl = lbl_call_gc;
+ { gc_size = n;
+ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_redo;
gc_frame = lbl_frame;
gc_spacetime; } :: !call_gc_sites
| Lop(Ispecific(Ibswap _)) ->
assert false
| Lop(Ispecific Isqrtf) ->
+ if arg i 0 <> res i 0 then
+ I.xorpd (res i 0) (res i 0); (* avoid partial register stall *)
I.sqrtsd (arg i 0) (res i 0)
| Lop(Ispecific(Ifloatsqrtf addr)) ->
+ I.xorpd (res i 0) (res i 0); (* avoid partial register stall *)
I.sqrtsd (addressing addr REAL8 i 0) (res i 0)
| Lop(Ispecific(Isextend32)) ->
I.movsxd (arg32 i 0) (res i 0)
+ | Lop(Ispecific(Izextend32)) ->
+ I.mov (arg32 i 0) (res32 i 0)
| Lop (Iname_for_debugger _) -> ()
| Lreloadretaddr ->
()
end;
begin match lbl2 with
| None -> ()
- | Some lbl -> I.jg (label lbl)
+ | Some lbl -> I.ja (label lbl)
end
| Lswitch jumptbl ->
let lbl = emit_label (new_label()) in
D.long (ConstSub (ConstLabel(emit_label jumptbl.(i)),
ConstLabel lbl))
done;
- D.text ()
+ emit_named_text_section !function_name
| Lentertrap ->
()
+ | Ladjust_trap_depth { delta_traps; } ->
+ (* each trap occupies 16 bytes on the stack *)
+ let delta = 16 * delta_traps in
+ cfi_adjust_cfa_offset delta;
+ stack_offset := !stack_offset + delta
| Lpushtrap { lbl_handler; } ->
let load_label_addr s arg =
if !Clflags.pic_code then
else
I.mov (sym (emit_label s)) arg
in
- cfi_adjust_cfa_offset 16;
- I.sub (int 16) rsp;
+ load_label_addr lbl_handler r11;
+ I.push r11;
+ cfi_adjust_cfa_offset 8;
+ I.push (domain_field Domainstate.Domain_exception_pointer);
+ cfi_adjust_cfa_offset 8;
+ I.mov rsp (domain_field Domainstate.Domain_exception_pointer);
stack_offset := !stack_offset + 16;
- I.mov r14 (mem64 QWORD 0 RSP);
- load_label_addr lbl_handler r14;
- I.mov r14 (mem64 QWORD 8 RSP);
- I.mov rsp r14
| Lpoptrap ->
- I.pop r14;
+ I.pop (domain_field Domainstate.Domain_exception_pointer);
cfi_adjust_cfa_offset (-8);
I.add (int 8) rsp;
cfi_adjust_cfa_offset (-8);
[caml_reraise_exn]. The only function called that might affect the
trie is [caml_stash_backtrace], and it does not. *)
begin match k with
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_regular ->
+ I.mov (int 0) (domain_field Domainstate.Domain_backtrace_pos);
+ emit_call "caml_raise_exn";
+ record_frame Reg.Set.empty true i.dbg
+ | Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
- | Cmm.Raise_notrace ->
- I.mov r14 rsp;
- I.pop r14;
+ | Lambda.Raise_notrace ->
+ I.mov (domain_field Domainstate.Domain_exception_pointer) rsp;
+ I.pop (domain_field Domainstate.Domain_exception_pointer);
I.pop r11;
I.jmp r11
end
| Lend -> ()
| _ ->
emit_instr fallthrough i;
- emit_all (Linearize.has_fallthrough i.desc) i.next
+ emit_all (Linear.has_fallthrough i.desc) i.next
let all_functions = ref []
call_gc_sites := [];
bound_error_sites := [];
bound_error_call := 0;
+ for i = 0 to Proc.num_register_classes - 1 do
+ num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+ done;
+ prologue_required := fundecl.fun_prologue_required;
+ frame_required := fundecl.fun_frame_required;
all_functions := fundecl :: !all_functions;
- D.text ();
+ emit_named_text_section !function_name;
D.align 16;
add_def_symbol fundecl.fun_name;
if system = S_macosx
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
- if frame_required() then begin
+ if !frame_required then begin
let n = frame_size() - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
float_constants := [];
all_functions := [];
if system = S_win64 then begin
- D.extrn "caml_young_ptr" QWORD;
- D.extrn "caml_young_limit" QWORD;
- D.extrn "caml_exception_pointer" QWORD;
D.extrn "caml_call_gc" NEAR;
+ D.extrn "caml_call_gc1" NEAR;
+ D.extrn "caml_call_gc2" NEAR;
+ D.extrn "caml_call_gc3" NEAR;
D.extrn "caml_c_call" NEAR;
D.extrn "caml_allocN" NEAR;
D.extrn "caml_alloc1" NEAR;
D.data ();
emit_global_label "data_begin";
- D.text ();
+ emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
emit_global_label "code_begin";
if system = S_macosx then I.nop (); (* PR#4690 *)
()
List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
end;
- D.text ();
+ emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
if system = S_macosx then I.nop ();
(* suppress "ld warning: atom sorting error" *)
r10 10
r11 11
rbp 12
- r14 trap pointer
+ r14 domain state pointer
r15 allocation pointer
xmm0 - xmm15 100 - 115 *)
| Iop (Iintop_imm(Icheckbound _, _)) when Config.spacetime ->
[| loc_spacetime_node_hole |]
| Iswitch(_, _) -> [| rax; rdx |]
+ | Itrywith _ -> [| r11 |]
| _ ->
if fp then
(* prevent any use of the frame pointer ! *)
| Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
| Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
- | Ispecific(Ilea _|Isextend32) -> true
+ | Ispecific(Ilea _|Isextend32|Izextend32) -> true
| Ispecific _ -> false
| _ -> true
(* Layout of the stack frame *)
-let num_stack_slots = [| 0; 0 |]
-let contains_calls = ref false
+let frame_required fd =
+ fp || fd.fun_contains_calls ||
+ fd.fun_num_stack_slots.(0) > 0 || fd.fun_num_stack_slots.(1) > 0
-let frame_required () =
- fp || !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0
-
-let prologue_required () =
- frame_required ()
+let prologue_required fd =
+ frame_required fd
(* Calling the assembler *)
end
-let fundecl f =
- (new reload)#fundecl f
+let fundecl f num_stack_slots =
+ (new reload)#fundecl f num_stack_slots
(* *)
(**************************************************************************)
-let _ = let module M = Schedgen in () (* to create a dependency *)
+open! Schedgen (* to create a dependency *)
(* Scheduling is turned off because the processor schedules dynamically
much better than what we could do. *)
(Ispecific Isextend32, [k])
| _ -> super#select_operation op args dbg
end
+ (* Recognize zero extension *)
+ | Cand ->
+ begin match args with
+ | [arg; Cconst_int (0xffff_ffff, _)]
+ | [arg; Cconst_natint (0xffff_ffffn, _)]
+ | [Cconst_int (0xffff_ffff, _); arg]
+ | [Cconst_natint (0xffff_ffffn, _); arg] ->
+ Ispecific Izextend32, [arg]
+ | _ -> super#select_operation op args dbg
+ end
| _ -> super#select_operation op args dbg
(* Recognize float arithmetic with mem *)
assert false
method! mark_c_tailcall =
- Proc.contains_calls := true
+ contains_calls := true
(* Deal with register constraints *)
open Proc
open Reg
open Mach
-open Linearize
+open Linear
open Emitaux
(* Tradeoff between code size and code speed *)
let stack_offset = ref 0
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
let frame_size () =
let sz =
!stack_offset +
` add lr, pc, lr\n`;
2
+
+(* Output .text section directive, or named .text.caml.<name> if enabled. *)
+
+let emit_named_text_section func_name =
+ if !Clflags.function_sections then begin
+ ` .section .text.caml.{emit_symbol func_name},{emit_string_literal "ax"},%progbits\n`
+ end
+ else
+ ` .text\n`
+
(* Output the assembly code for an instruction *)
let emit_instr i =
match i.desc with
| Lend -> 0
| Lprologue ->
- assert (Proc.prologue_required ());
+ assert (!prologue_required);
let n = frame_size() in
let num_instrs =
if n > 0 then begin
if !fastcode_flag then begin
let lbl_redo = new_label() in
`{emit_label lbl_redo}:`;
- let ninstr = decompose_intconst
- (Int32.of_int n)
- (fun i ->
- ` sub alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in
- ` cmp alloc_ptr, alloc_limit\n`;
- ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
+ let first = ref true in
+ let ninstr =
+ decompose_intconst (Int32.of_int (n - 4)) (fun a ->
+ if !first
+ then ` sub {emit_reg i.res.(0)}, alloc_ptr, #{emit_int32 a}\n`
+ else ` sub {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #{emit_int32 a}\n`;
+ first := false) in
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ let tmp = if i.res.(0).loc = Reg 8 (* r12 *) then phys_reg 7 (* r7 *)
+ else phys_reg 8 (* r12 *)
+ in
+ ` ldr {emit_reg tmp}, [domain_state_ptr, {emit_int offset}]\n`;
+ ` cmp {emit_reg i.res.(0)}, {emit_reg tmp}\n`;
let lbl_call_gc = new_label() in
- ` bcc {emit_label lbl_call_gc}\n`;
+ ` bls {emit_label lbl_call_gc}\n`;
+ ` sub alloc_ptr, {emit_reg i.res.(0)}, #4\n`;
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_redo;
end
| Lentertrap ->
0
+ | Ladjust_trap_depth { delta_traps } ->
+ (* each trap occupies 8 bytes on the stack *)
+ let delta = 8 * delta_traps in
+ cfi_adjust_cfa_offset delta;
+ stack_offset := !stack_offset + delta; 0
| Lpushtrap { lbl_handler; } ->
let s = emit_load_handler_address lbl_handler in
stack_offset := !stack_offset + 8;
stack_offset := !stack_offset - 8; 1
| Lraise k ->
begin match k with
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_regular ->
+ let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+ ` mov r12, #0\n`;
+ ` str r12, [domain_state_ptr, {emit_int offset}]\n`;
+ ` {emit_call "caml_raise_exn"}\n`;
+ `{record_frame Reg.Set.empty true i.dbg}\n`; 3
+ | Lambda.Raise_reraise ->
` {emit_call "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`; 1
- | Cmm.Raise_notrace ->
+ | Lambda.Raise_notrace ->
` mov sp, trap_ptr\n`;
` pop \{trap_ptr, pc}\n`; 2
end
stack_offset := 0;
call_gc_sites := [];
bound_error_sites := [];
- ` .text\n`;
+ for i = 0 to Proc.num_register_classes - 1 do
+ num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+ done;
+ contains_calls := fundecl.fun_contains_calls;
+ prologue_required := fundecl.fun_prologue_required;
+ emit_named_text_section !function_name;
` .align 2\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
if !arch > ARMv6 && !thumb then
end;
`trap_ptr .req r8\n`;
`alloc_ptr .req r10\n`;
- `alloc_limit .req r11\n`;
+ `domain_state_ptr .req r11\n`;
let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
` .data\n`;
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`;
let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
- ` .text\n`;
+ emit_named_text_section lbl_begin;
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`
let end_assembly () =
let lbl_end = Compilenv.make_symbol (Some "code_end") in
- ` .text\n`;
+ emit_named_text_section lbl_end;
` .globl {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
let lbl_end = Compilenv.make_symbol (Some "data_end") in
r8 trap pointer (preserved)
r9 platform register, usually reserved
r10 allocation pointer (preserved)
- r11 allocation limit (preserved)
+ r11 domain state pointer (preserved)
r12 intra-procedural scratch register (not preserved)
r13 stack pointer
r14 return address
(* Layout of the stack *)
-let num_stack_slots = [| 0; 0; 0 |]
-let contains_calls = ref false
-
-let frame_required () =
- !contains_calls
+let frame_required fd =
+ let num_stack_slots = fd.fun_num_stack_slots in
+ fd.fun_contains_calls
|| num_stack_slots.(0) > 0
|| num_stack_slots.(1) > 0
|| num_stack_slots.(2) > 0
-let prologue_required () =
- frame_required ()
+let prologue_required fd =
+ frame_required fd
(* Calling the assembler *)
argres'
end
-let fundecl f =
- (new reload)#fundecl f
+let fundecl f num_stack_slots =
+ (new reload)#fundecl f num_stack_slots
open Proc
open Reg
open Mach
-open Linearize
+open Linear
open Emitaux
(* Tradeoff between code size and code speed *)
(* Names for special regs *)
+let reg_domain_state_ptr = phys_reg 22
let reg_trap_ptr = phys_reg 23
let reg_alloc_ptr = phys_reg 24
let reg_alloc_limit = phys_reg 25
let stack_offset = ref 0
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
let frame_size () =
let sz =
!stack_offset +
+ begin match lbl2 with None -> 0 | Some _ -> 1 end
| Lswitch jumptbl -> 3 + Array.length jumptbl
| Lentertrap -> 0
+ | Ladjust_trap_depth _ -> 0
| Lpushtrap _ -> 4
| Lpoptrap -> 1
| Lraise k ->
begin match k with
- | Cmm.Raise_withtrace -> 1
- | Cmm.Raise_notrace -> 4
+ | Lambda.Raise_regular -> 2
+ | Lambda.Raise_reraise -> 1
+ | Lambda.Raise_notrace -> 4
end
let relax_allocation ~num_bytes ~label_after_call_gc =
if !fastcode_flag then begin
let lbl_redo = new_label() in
let lbl_call_gc = new_label() in
- assert (n < 0x1_000_000);
- let nl = n land 0xFFF and nh = n land 0xFFF_000 in
+ (* n is at most Max_young_whsize * 8, i.e. currently 0x808,
+ so it is reasonable to assume n < 0x1_000. This makes
+ the generated code simpler. *)
+ assert (16 <= n && n < 0x1_000 && n land 0x7 = 0);
+ (* Instead of checking whether young_ptr - n < young_limit, we check whether
+ young_ptr - (n - 8) <= young_limit. It's equivalent, but this way around
+ we can avoid mutating young_ptr on failed allocations, by doing the
+ calculations in i.res.(0) instead of young_ptr. *)
`{emit_label lbl_redo}:`;
- if nh <> 0 then
- ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int nh}\n`;
- if nl <> 0 then
- ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int nl}\n`;
- ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
- ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
+ ` sub {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #{emit_int (n - 8)}\n`;
+ ` cmp {emit_reg i.res.(0)}, {emit_reg reg_alloc_limit}\n`;
if not far then begin
- ` b.lo {emit_label lbl_call_gc}\n`
+ ` b.ls {emit_label lbl_call_gc}\n`
end else begin
let lbl = new_label () in
- ` b.cs {emit_label lbl}\n`;
+ ` b.hi {emit_label lbl}\n`;
` b {emit_label lbl_call_gc}\n`;
`{emit_label lbl}:\n`
end;
+ ` sub {emit_reg reg_alloc_ptr}, {emit_reg i.res.(0)}, #8\n`;
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_redo;
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
end
+(* Output .text section directive, or named .text.caml.<name> if enabled. *)
+
+let emit_named_text_section func_name =
+ if !Clflags.function_sections then begin
+ ` .section .text.caml.{emit_symbol func_name},{emit_string_literal "ax"},%progbits\n`
+ end
+ else
+ ` .text\n`
+
(* Output the assembly code for an instruction *)
let emit_instr i =
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (Proc.prologue_required ());
+ assert (!prologue_required);
let n = frame_size() in
if n > 0 then
emit_stack_adjustment (-n);
*)
| Lentertrap ->
()
+ | Ladjust_trap_depth { delta_traps } ->
+ (* each trap occupies 16 bytes on the stack *)
+ let delta = 16 * delta_traps in
+ cfi_adjust_cfa_offset delta;
+ stack_offset := !stack_offset + delta
| Lpushtrap { lbl_handler; } ->
` adr {emit_reg reg_tmp1}, {emit_label lbl_handler}\n`;
stack_offset := !stack_offset + 16;
stack_offset := !stack_offset - 16
| Lraise k ->
begin match k with
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_regular ->
+ let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+ ` str xzr, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n`;
+ ` bl {emit_symbol "caml_raise_exn"}\n`;
+ `{record_frame Reg.Set.empty true i.dbg}\n`
+ | Lambda.Raise_reraise ->
` bl {emit_symbol "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`
- | Cmm.Raise_notrace ->
+ | Lambda.Raise_notrace ->
` mov sp, {emit_reg reg_trap_ptr}\n`;
` ldr {emit_reg reg_tmp1}, [sp, #8]\n`;
` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`;
stack_offset := 0;
call_gc_sites := [];
bound_error_sites := [];
- ` .text\n`;
+ for i = 0 to Proc.num_register_classes - 1 do
+ num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+ done;
+ prologue_required := fundecl.fun_prologue_required;
+ contains_calls := fundecl.fun_contains_calls;
+ emit_named_text_section !function_name;
` .align 3\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
` .type {emit_symbol fundecl.fun_name}, %function\n`;
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`;
let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
- ` .text\n`;
+ emit_named_text_section lbl_begin;
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`
let end_assembly () =
let lbl_end = Compilenv.make_symbol (Some "code_end") in
- ` .text\n`;
+ emit_named_text_section lbl_end;
` .globl {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
let lbl_end = Compilenv.make_symbol (Some "data_end") in
x0 - x15 general purpose (caller-save)
x16, x17 temporaries (used by call veeners)
x18 platform register (reserved)
- x19 - x25 general purpose (callee-save)
+ x19 - x24 general purpose (callee-save)
+ x25 domain state pointer
x26 trap pointer
x27 alloc pointer
x28 alloc limit
let int_reg_name =
[| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7";
"x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15";
- "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; "x25";
- "x26"; "x27"; "x28"; "x16"; "x17" |]
+ "x19"; "x20"; "x21"; "x22"; "x23"; "x24";
+ "x25"; "x26"; "x27"; "x28"; "x16"; "x17" |]
let float_reg_name =
[| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7";
| Float -> 1
let num_available_registers =
- [| 23; 32 |] (* first 23 int regs allocatable; all float regs allocatable *)
+ [| 22; 32 |] (* first 22 int regs allocatable; all float regs allocatable *)
let first_available_register =
[| 0; 100 |]
let int_dwarf_reg_numbers =
[| 0; 1; 2; 3; 4; 5; 6; 7;
8; 9; 10; 11; 12; 13; 14; 15;
- 19; 20; 21; 22; 23; 24; 25;
- 26; 27; 28; 16; 17;
+ 19; 20; 21; 22; 23; 24;
+ 25; 26; 27; 28; 16; 17;
|]
let float_dwarf_reg_numbers =
let safe_register_pressure = function
| Iextcall _ -> 8
- | Ialloc _ -> 25
- | _ -> 26
+ | Ialloc _ -> 24
+ | _ -> 25
let max_register_pressure = function
| Iextcall _ -> [| 10; 8 |]
- | Ialloc _ -> [| 25; 32 |]
+ | Ialloc _ -> [| 24; 32 |]
| Iintoffloat | Ifloatofint
- | Iload(Single, _) | Istore(Single, _, _) -> [| 26; 31 |]
- | _ -> [| 26; 32 |]
+ | Iload(Single, _) | Istore(Single, _, _) -> [| 25; 31 |]
+ | _ -> [| 25; 32 |]
(* Pure operations (without any side effect besides updating their result
registers). *)
| _ -> true
(* Layout of the stack *)
+let frame_required fd =
+ fd.fun_contains_calls
+ || fd.fun_num_stack_slots.(0) > 0
+ || fd.fun_num_stack_slots.(1) > 0
-let num_stack_slots = [| 0; 0 |]
-let contains_calls = ref false
-
-let frame_required () =
- !contains_calls
- || num_stack_slots.(0) > 0
- || num_stack_slots.(1) > 0
-
-let prologue_required () =
- frame_required ()
+let prologue_required fd =
+ frame_required fd
(* Calling the assembler *)
(* Reloading for the ARM 64 bits *)
-let fundecl f =
- (new Reloadgen.reload_generic)#fundecl f
+let fundecl f num_stack_slots =
+ (new Reloadgen.reload_generic)#fundecl f num_stack_slots
(* *)
(**************************************************************************)
-let _ = let module M = Schedgen in () (* to create a dependency *)
+open! Schedgen (* to create a dependency *)
(* Scheduling is turned off because the processor schedules dynamically
much better than what we could do. *)
if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
phrase
-let flambda_raw_clambda_dump_if ppf
- ({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _;
- structured_constants; exported = _; } as input) =
- if !dump_rawclambda then
- begin
- Format.fprintf ppf "@.clambda (before Un_anf):@.";
- Printclambda.clambda ppf ulambda;
- Symbol.Map.iter (fun sym cst ->
- Format.fprintf ppf "%a:@ %a@."
- Symbol.print sym
- Printclambda.structured_constant cst)
- structured_constants
- end;
- if !dump_cmm then Format.fprintf ppf "@.cmm:@.";
- input
-
-type clambda_and_constants =
- Clambda.ulambda *
- Clambda.preallocated_block list *
- Clambda.preallocated_constant list
-
-let raw_clambda_dump_if ppf
- ((ulambda, _, structured_constants):clambda_and_constants) =
- if !dump_rawclambda || !dump_clambda then
- begin
- Format.fprintf ppf "@.clambda:@.";
- Printclambda.clambda ppf ulambda;
- List.iter (fun {Clambda.symbol; definition} ->
- Format.fprintf ppf "%s:@ %a@."
- symbol
- Printclambda.structured_constant definition)
- structured_constants
- end;
- if !dump_cmm then Format.fprintf ppf "@.cmm:@."
-
let rec regalloc ~ppf_dump round fd =
if round > 50 then
fatal_error(fd.Mach.fun_name ^
": function too complex, cannot complete register allocation");
dump_if ppf_dump dump_live "Liveness analysis" fd;
- if !use_linscan then begin
- (* Linear Scan *)
- Interval.build_intervals fd;
- if !dump_interval then Printmach.intervals ppf_dump ();
- Linscan.allocate_registers()
- end else begin
- (* Graph Coloring *)
- Interf.build_graph fd;
- if !dump_interf then Printmach.interferences ppf_dump ();
- if !dump_prefer then Printmach.preferences ppf_dump ();
- Coloring.allocate_registers()
- end;
+ let num_stack_slots =
+ if !use_linscan then begin
+ (* Linear Scan *)
+ Interval.build_intervals fd;
+ if !dump_interval then Printmach.intervals ppf_dump ();
+ Linscan.allocate_registers()
+ end else begin
+ (* Graph Coloring *)
+ Interf.build_graph fd;
+ if !dump_interf then Printmach.interferences ppf_dump ();
+ if !dump_prefer then Printmach.preferences ppf_dump ();
+ Coloring.allocate_registers()
+ end
+ in
dump_if ppf_dump dump_regalloc "After register allocation" fd;
- let (newfd, redo_regalloc) = Reload.fundecl fd in
+ let (newfd, redo_regalloc) = Reload.fundecl fd num_stack_slots in
dump_if ppf_dump dump_reload "After insertion of reloading code" newfd;
if redo_regalloc then begin
Reg.reinit(); Liveness.fundecl newfd; regalloc ~ppf_dump (round + 1) newfd
let compile_fundecl ~ppf_dump fd_cmm =
Proc.init ();
- Cmmgen.reset ();
Reg.reset();
fd_cmm
++ Profile.record ~accumulate:true "selection" Selection.fundecl
| (Cfunction {fun_name = name}) as ph when f name ->
compile_phrase ~ppf_dump ph
| _ -> ())
- (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
+ (Cmm_helpers.generic_functions true [Compilenv.current_unit_infos ()])
-let compile_unit _output_prefix asm_filename keep_asm
- obj_filename gen =
+let compile_unit asm_filename keep_asm obj_filename gen =
let create_asm = keep_asm || not !Emitaux.binary_backend_available in
Emitaux.create_asm_file := create_asm;
Misc.try_finally
if create_asm && not keep_asm then remove_file asm_filename
)
-let set_export_info (ulambda, prealloc, structured_constants, export) =
- Compilenv.set_export_info export;
- (ulambda, prealloc, structured_constants)
-
let end_gen_implementation ?toplevel ~ppf_dump
- (clambda:clambda_and_constants) =
+ (clambda : Clambda.with_constants) =
Emit.begin_assembly ();
clambda
- ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump)
+ ++ Profile.record "cmm" Cmmgen.compunit
++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump))
++ (fun () -> ());
(match toplevel with None -> () | Some f -> compile_genfuns ~ppf_dump f);
-
(* We add explicit references to external primitive symbols. This
is to ensure that the object files that define these symbols,
when part of a C library, won't be discarded by the linker.
This is important if a module that uses such a symbol is later
dynlinked. *)
-
compile_phrase ~ppf_dump
- (Cmmgen.reference_symbols
- (List.filter (fun s -> s <> "" && s.[0] <> '%')
- (List.map Primitive.native_name !Translmod.primitive_declarations))
- );
+ (Cmm_helpers.reference_symbols
+ (List.filter_map (fun prim ->
+ if not (Primitive.native_name_is_external prim) then None
+ else Some (Primitive.native_name prim))
+ !Translmod.primitive_declarations));
Emit.end_assembly ()
-let flambda_gen_implementation ?toplevel ~backend ~ppf_dump
- (program:Flambda.program) =
- let export = Build_export_info.build_transient ~backend program in
- let (clambda, preallocated, constants) =
- Profile.record_call "backend" (fun () ->
- (program, export)
- ++ Flambda_to_clambda.convert
- ++ flambda_raw_clambda_dump_if ppf_dump
- ++ (fun { Flambda_to_clambda. expr; preallocated_blocks;
- structured_constants; exported; } ->
- (* "init_code" following the name used in
- [Cmmgen.compunit_and_constants]. *)
- Un_anf.apply ~ppf_dump expr ~what:"init_code", preallocated_blocks,
- structured_constants, exported)
- ++ set_export_info)
- in
- let constants =
- List.map (fun (symbol, definition) ->
- { Clambda.symbol = Linkage_name.to_string (Symbol.label symbol);
- exported = true;
- definition;
- provenance = None;
- })
- (Symbol.Map.bindings constants)
- in
- end_gen_implementation ?toplevel ~ppf_dump
- (clambda, preallocated, constants)
+type middle_end =
+ backend:(module Backend_intf.S)
+ -> filename:string
+ -> prefixname:string
+ -> ppf_dump:Format.formatter
+ -> Lambda.program
+ -> Clambda.with_constants
-let lambda_gen_implementation ?toplevel ~backend ~ppf_dump
- (lambda:Lambda.program) =
- let clambda =
- Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
- in
- let provenance : Clambda.usymbol_provenance =
- { original_idents = [];
- module_path =
- Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ()));
- }
- in
- let preallocated_block =
- Clambda.{
- symbol = Compilenv.make_symbol None;
- exported = true;
- tag = 0;
- fields = List.init lambda.main_module_block_size (fun _ -> None);
- provenance = Some provenance;
- }
- in
- let clambda_and_constants =
- clambda, [preallocated_block], Compilenv.structured_constants ()
- in
- Compilenv.clear_structured_constants ();
- raw_clambda_dump_if ppf_dump clambda_and_constants;
- end_gen_implementation ?toplevel ~ppf_dump clambda_and_constants
-
-let compile_implementation_gen ?toplevel prefixname
- ~required_globals ~ppf_dump gen_implementation program =
+let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
+ ~ppf_dump (program : Lambda.program) =
let asmfile =
if !keep_asm_file || !Emitaux.binary_backend_available
then prefixname ^ ext_asm
else Filename.temp_file "camlasm" ext_asm
in
- compile_unit prefixname asmfile !keep_asm_file
- (prefixname ^ ext_obj) (fun () ->
- Ident.Set.iter Compilenv.require_global required_globals;
- gen_implementation ?toplevel ~ppf_dump program)
-
-let compile_implementation_clambda ?toplevel prefixname
- ~backend ~ppf_dump (program:Lambda.program) =
- compile_implementation_gen ?toplevel prefixname
- ~required_globals:program.Lambda.required_globals
- ~ppf_dump (lambda_gen_implementation ~backend) program
-
-let compile_implementation_flambda ?toplevel prefixname
- ~required_globals ~backend ~ppf_dump (program:Flambda.program) =
- compile_implementation_gen ?toplevel prefixname
- ~required_globals ~ppf_dump (flambda_gen_implementation ~backend) program
+ compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj)
+ (fun () ->
+ Ident.Set.iter Compilenv.require_global program.required_globals;
+ let clambda_with_constants =
+ middle_end ~backend ~filename ~prefixname ~ppf_dump program
+ in
+ end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants)
(* Error report *)
(* *)
(**************************************************************************)
-(* From lambda to assembly code *)
+(** From Lambda to assembly code *)
-val compile_implementation_flambda :
- ?toplevel:(string -> bool) ->
- string ->
- required_globals:Ident.Set.t ->
- backend:(module Backend_intf.S) ->
- ppf_dump:Format.formatter -> Flambda.program -> unit
+(** The type of converters from Lambda to Clambda. *)
+type middle_end =
+ backend:(module Backend_intf.S)
+ -> filename:string
+ -> prefixname:string
+ -> ppf_dump:Format.formatter
+ -> Lambda.program
+ -> Clambda.with_constants
-val compile_implementation_clambda :
- ?toplevel:(string -> bool) ->
- string ->
- backend:(module Backend_intf.S) ->
- ppf_dump:Format.formatter -> Lambda.program -> unit
+(** Compile an implementation from Lambda using the given middle end. *)
+val compile_implementation
+ : ?toplevel:(string -> bool)
+ -> backend:(module Backend_intf.S)
+ -> filename:string
+ -> prefixname:string
+ -> middle_end:middle_end
+ -> ppf_dump:Format.formatter
+ -> Lambda.program
+ -> unit
val compile_phrase :
ppf_dump:Format.formatter -> Cmm.phrase -> unit
val compile_unit:
- string(*prefixname*) ->
string(*asm file*) -> bool(*keep asm*) ->
string(*obj file*) -> (unit -> unit) -> unit
Emit.begin_assembly ();
let name_list =
List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
- compile_phrase (Cmmgen.entry_point name_list);
+ compile_phrase (Cmm_helpers.entry_point name_list);
let units = List.map (fun (info,_,_) -> info) units_list in
- List.iter compile_phrase (Cmmgen.generic_functions false units);
+ List.iter compile_phrase (Cmm_helpers.generic_functions false units);
Array.iteri
- (fun i name -> compile_phrase (Cmmgen.predef_exception i name))
+ (fun i name -> compile_phrase (Cmm_helpers.predef_exception i name))
Runtimedef.builtin_exceptions;
- compile_phrase (Cmmgen.global_table name_list);
+ compile_phrase (Cmm_helpers.global_table name_list);
let globals_map = make_globals_map units_list ~crc_interfaces in
- compile_phrase (Cmmgen.globals_map globals_map);
- compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
- compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
+ compile_phrase (Cmm_helpers.globals_map globals_map);
+ compile_phrase(Cmm_helpers.data_segment_table ("_startup" :: name_list));
+ if !Clflags.function_sections then
+ compile_phrase
+ (Cmm_helpers.code_segment_table("_hot" :: "_startup" :: name_list))
+ else
+ compile_phrase(Cmm_helpers.code_segment_table("_startup" :: name_list));
let all_names = "_startup" :: "_system" :: name_list in
- compile_phrase (Cmmgen.frame_table all_names);
+ compile_phrase (Cmm_helpers.frame_table all_names);
if Config.spacetime then begin
- compile_phrase (Cmmgen.spacetime_shapes all_names);
+ compile_phrase (Cmm_helpers.spacetime_shapes all_names);
end;
if !Clflags.output_complete_object then
force_linking_of_startup ~ppf_dump;
Compilenv.reset "_shared_startup";
Emit.begin_assembly ();
List.iter compile_phrase
- (Cmmgen.generic_functions true (List.map fst units));
- compile_phrase (Cmmgen.plugin_header units);
+ (Cmm_helpers.generic_functions true (List.map fst units));
+ compile_phrase (Cmm_helpers.plugin_header units);
compile_phrase
- (Cmmgen.global_table
+ (Cmm_helpers.global_table
(List.map (fun (ui,_) -> ui.ui_symbol) units));
if !Clflags.output_complete_object then
force_linking_of_startup ~ppf_dump;
then output_name ^ ".startup" ^ ext_asm
else Filename.temp_file "camlstartup" ext_asm in
let startup_obj = output_name ^ ".startup" ^ ext_obj in
- Asmgen.compile_unit output_name
+ Asmgen.compile_unit
startup !Clflags.keep_startup_file startup_obj
(fun () ->
make_shared_startup_file ~ppf_dump
then output_name ^ ".startup" ^ ext_asm
else Filename.temp_file "camlstartup" ext_asm in
let startup_obj = Filename.temp_file "camlstartup" ext_obj in
- Asmgen.compile_unit output_name
+ Asmgen.compile_unit
startup !Clflags.keep_startup_file startup_obj
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
Misc.try_finally
members in
let module_ident = Ident.create_persistent targetname in
let prefixname = Filename.remove_extension objtemp in
- if Config.flambda then begin
- let size, lam = Translmod.transl_package_flambda components coercion in
- let lam = Simplif.simplify_lambda lam in
- let flam =
- Flambda_middle_end.middle_end ~ppf_dump
- ~prefixname
- ~backend
- ~size
- ~filename:targetname
- ~module_ident
- ~module_initializer:lam
- in
- Asmgen.compile_implementation_flambda
- prefixname ~backend ~required_globals:Ident.Set.empty ~ppf_dump flam;
- end else begin
- let main_module_block_size, code =
- Translmod.transl_store_package
- components (Ident.create_persistent targetname) coercion in
- let code = Simplif.simplify_lambda code in
- Asmgen.compile_implementation_clambda
- prefixname ~backend ~ppf_dump { Lambda.code; main_module_block_size;
- module_ident; required_globals = Ident.Set.empty }
- end;
+ let required_globals = Ident.Set.empty in
+ let program, middle_end =
+ if Config.flambda then
+ let main_module_block_size, code =
+ Translmod.transl_package_flambda components coercion
+ in
+ let code = Simplif.simplify_lambda code in
+ let program =
+ { Lambda.
+ code;
+ main_module_block_size;
+ module_ident;
+ required_globals;
+ }
+ in
+ program, Flambda_middle_end.lambda_to_clambda
+ else
+ let main_module_block_size, code =
+ Translmod.transl_store_package components
+ (Ident.create_persistent targetname) coercion
+ in
+ let code = Simplif.simplify_lambda code in
+ let program =
+ { Lambda.
+ code;
+ main_module_block_size;
+ module_ident;
+ required_globals;
+ }
+ in
+ program, Closure_middle_end.lambda_to_clambda
+ in
+ Asmgen.compile_implementation ~backend
+ ~filename:targetname
+ ~prefixname
+ ~middle_end
+ ~ppf_dump
+ program;
let objfiles =
List.map
(fun m -> Filename.remove_extension m.pm_file ^ Config.ext_obj)
remove_file objtemp;
if not ok then raise(Error Linking_error)
)
+
(* Make the .cmx file for the package *)
let get_export_info ui =
(**************************************************************************)
open Mach
-open Linearize
+open Linear
module Make (T : Branch_relaxation_intf.S) = struct
let label_map code =
| Some branch ->
let max_branch_offset =
(* Remember to cut some slack for multi-word instructions (in the
- [Linearize] sense of the word) where the branch can be anywhere in
+ [Linear] sense of the word) where the branch can be anywhere in
the middle. 12 words of slack is plenty. *)
T.Cond_branch.max_displacement branch - 12
in
module Make (T : Branch_relaxation_intf.S) : sig
val relax
- : Linearize.instruction
+ : Linear.instruction
(* [max_offset_of_out_of_line_code] specifies the furthest distance,
measured from the first address immediately after the last instruction
of the function, that may be branched to from within the function in
- Lcondbranch3 (_, _, _)
[classify_instr] is expected to return [None] when called on any
instruction not in this list. *)
- val classify_instr : Linearize.instruction_desc -> t option
+ val classify_instr : Linear.instruction_desc -> t option
end
(* The value to be added to the program counter (in [distance] units)
val offset_pc_at_branch : distance
(* The maximum size of a given instruction. *)
- val instr_size : Linearize.instruction_desc -> distance
+ val instr_size : Linear.instruction_desc -> distance
(* Insertion of target-specific code to relax operations that cannot be
relaxed generically. It is assumed that these rewrites do not change
val relax_allocation
: num_bytes:int
-> label_after_call_gc:Cmm.label option
- -> Linearize.instruction_desc
+ -> Linear.instruction_desc
val relax_intop_checkbound
: label_after_error:Cmm.label option
- -> Linearize.instruction_desc
+ -> Linear.instruction_desc
val relax_intop_imm_checkbound
: bound:int
-> label_after_error:Cmm.label option
- -> Linearize.instruction_desc
- val relax_specific_op : Arch.specific_operation -> Linearize.instruction_desc
+ -> Linear.instruction_desc
+ val relax_specific_op : Arch.specific_operation -> Linear.instruction_desc
end
let typ_int = [|Int|]
let typ_float = [|Float|]
-let size_component = function
- | Val | Addr -> Arch.size_addr
- | Int -> Arch.size_int
- | Float -> Arch.size_float
-
(** [machtype_component]s are partially ordered as follows:
Addr Float
| Float, (Int | Addr | Val) ->
assert false
-let size_machtype mty =
- let size = ref 0 in
- for i = 0 to Array.length mty - 1 do
- size := !size + size_component mty.(i)
- done;
- !size
-
type integer_comparison = Lambda.integer_comparison =
| Ceq | Cne | Clt | Cgt | Cle | Cge
let new_label() = incr label_counter; !label_counter
-type raise_kind =
- | Raise_withtrace
- | Raise_notrace
-
type rec_flag = Nonrecursive | Recursive
type phantom_defining_expr =
| Caddf | Csubf | Cmulf | Cdivf
| Cfloatofint | Cintoffloat
| Ccmpf of float_comparison
- | Craise of raise_kind
+ | Craise of Lambda.raise_kind
| Ccheckbound
type expression =
let reset () =
label_counter := 99
+
+let iter_shallow_tail f = function
+ | Clet(_, _, body) | Cphantom_let (_, _, body) ->
+ f body;
+ true
+ | Cifthenelse(_cond, _ifso_dbg, ifso, _ifnot_dbg, ifnot, _dbg) ->
+ f ifso;
+ f ifnot;
+ true
+ | Csequence(_e1, e2) ->
+ f e2;
+ true
+ | Cswitch(_e, _tbl, el, _dbg') ->
+ Array.iter (fun (e, _dbg) -> f e) el;
+ true
+ | Ccatch(_rec_flag, handlers, body) ->
+ List.iter (fun (_, _, h, _dbg) -> f h) handlers;
+ f body;
+ true
+ | Ctrywith(e1, _id, e2, _dbg) ->
+ f e1;
+ f e2;
+ true
+ | Cexit _ | Cop (Craise _, _, _) ->
+ true
+ | Cconst_int _
+ | Cconst_natint _
+ | Cconst_float _
+ | Cconst_symbol _
+ | Cconst_pointer _
+ | Cconst_natpointer _
+ | Cblockheader _
+ | Cvar _
+ | Cassign _
+ | Ctuple _
+ | Cop _ ->
+ false
+
+let rec map_tail f = function
+ | Clet(id, exp, body) ->
+ Clet(id, exp, map_tail f body)
+ | Cphantom_let(id, exp, body) ->
+ Cphantom_let (id, exp, map_tail f body)
+ | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
+ Cifthenelse
+ (
+ cond,
+ ifso_dbg, map_tail f ifso,
+ ifnot_dbg, map_tail f ifnot,
+ dbg
+ )
+ | Csequence(e1, e2) ->
+ Csequence(e1, map_tail f e2)
+ | Cswitch(e, tbl, el, dbg') ->
+ Cswitch(e, tbl, Array.map (fun (e, dbg) -> map_tail f e, dbg) el, dbg')
+ | Ccatch(rec_flag, handlers, body) ->
+ let map_h (n, ids, handler, dbg) = (n, ids, map_tail f handler, dbg) in
+ Ccatch(rec_flag, List.map map_h handlers, map_tail f body)
+ | Ctrywith(e1, id, e2, dbg) ->
+ Ctrywith(map_tail f e1, id, map_tail f e2, dbg)
+ | Cexit _ | Cop (Craise _, _, _) as cmm ->
+ cmm
+ | Cconst_int _
+ | Cconst_natint _
+ | Cconst_float _
+ | Cconst_symbol _
+ | Cconst_pointer _
+ | Cconst_natpointer _
+ | Cblockheader _
+ | Cvar _
+ | Cassign _
+ | Ctuple _
+ | Cop _ as c ->
+ f c
+
+let map_shallow f = function
+ | Clet (id, e1, e2) ->
+ Clet (id, f e1, f e2)
+ | Cphantom_let (id, de, e) ->
+ Cphantom_let (id, de, f e)
+ | Cassign (id, e) ->
+ Cassign (id, f e)
+ | Ctuple el ->
+ Ctuple (List.map f el)
+ | Cop (op, el, dbg) ->
+ Cop (op, List.map f el, dbg)
+ | Csequence (e1, e2) ->
+ Csequence (f e1, f e2)
+ | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
+ Cifthenelse(f cond, ifso_dbg, f ifso, ifnot_dbg, f ifnot, dbg)
+ | Cswitch (e, ia, ea, dbg) ->
+ Cswitch (e, ia, Array.map (fun (e, dbg) -> f e, dbg) ea, dbg)
+ | Ccatch (rf, hl, body) ->
+ let map_h (n, ids, handler, dbg) = (n, ids, f handler, dbg) in
+ Ccatch (rf, List.map map_h hl, f body)
+ | Cexit (n, el) ->
+ Cexit (n, List.map f el)
+ | Ctrywith (e1, id, e2, dbg) ->
+ Ctrywith (f e1, id, f e2, dbg)
+ | Cconst_int _
+ | Cconst_natint _
+ | Cconst_float _
+ | Cconst_symbol _
+ | Cconst_pointer _
+ | Cconst_natpointer _
+ | Cblockheader _
+ | Cvar _
+ as c ->
+ c
val typ_int: machtype
val typ_float: machtype
-val size_component: machtype_component -> int
-
(** Least upper bound of two [machtype_component]s. *)
val lub_component
: machtype_component
-> machtype_component
-> bool
-val size_machtype: machtype -> int
-
type integer_comparison = Lambda.integer_comparison =
| Ceq | Cne | Clt | Cgt | Cle | Cge
type label = int
val new_label: unit -> label
-type raise_kind =
- | Raise_withtrace
- | Raise_notrace
-
type rec_flag = Nonrecursive | Recursive
type phantom_defining_expr =
| Caddf | Csubf | Cmulf | Cdivf
| Cfloatofint | Cintoffloat
| Ccmpf of float_comparison
- | Craise of raise_kind
- | Ccheckbound
+ | Craise of Lambda.raise_kind
+ | Ccheckbound (* Takes two arguments : first the bound to check against,
+ then the index.
+ It results in a bounds error if the index is greater than
+ or equal to the bound. *)
(** Every basic block should have a corresponding [Debuginfo.t] for its
beginning. *)
-> expression
val reset : unit -> unit
+
+val iter_shallow_tail: (expression -> unit) -> expression -> bool
+ (** Either apply the callback to all immediate sub-expressions that
+ can produce the final result for the expression and return
+ [true], or do nothing and return [false]. Note that the notion
+ of "tail" sub-expression used here does not match the one used
+ to trigger tail calls; in particular, try...with handlers are
+ considered to be in tail position (because their result become
+ the final result for the expression). *)
+
+val map_tail: (expression -> expression) -> expression -> expression
+ (** Apply the transformation to an expression, trying to push it
+ to all inner sub-expressions that can produce the final result.
+ Same disclaimer as for [iter_shallow_tail] about the notion
+ of "tail" sub-expression. *)
+
+val map_shallow: (expression -> expression) -> expression -> expression
+ (** Apply the transformation to each immediate sub-expression. *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-40-41-42-44-45"]
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+open Cmm
+open Arch
+
+(* Local binding of complex expressions *)
+
+let bind name arg fn =
+ match arg with
+ Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
+ | Cconst_pointer _ | Cconst_natpointer _
+ | Cblockheader _ -> fn arg
+ | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
+
+let bind_load name arg fn =
+ match arg with
+ | Cop(Cload _, [Cvar _], _) -> fn arg
+ | _ -> bind name arg fn
+
+let bind_nonvar name arg fn =
+ match arg with
+ Cconst_int _ | Cconst_natint _ | Cconst_symbol _
+ | Cconst_pointer _ | Cconst_natpointer _
+ | Cblockheader _ -> fn arg
+ | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
+
+let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
+ (* cf. runtime/caml/gc.h *)
+
+(* Block headers. Meaning of the tag field: see stdlib/obj.ml *)
+
+let floatarray_tag dbg = Cconst_int (Obj.double_array_tag, dbg)
+
+let block_header tag sz =
+ Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10)
+ (Nativeint.of_int tag)
+(* Static data corresponding to "value"s must be marked black in case we are
+ in no-naked-pointers mode. See [caml_darken] and the code below that emits
+ structured constants and static module definitions. *)
+let black_block_header tag sz = Nativeint.logor (block_header tag sz) caml_black
+let white_closure_header sz = block_header Obj.closure_tag sz
+let black_closure_header sz = black_block_header Obj.closure_tag sz
+let infix_header ofs = block_header Obj.infix_tag ofs
+let float_header = block_header Obj.double_tag (size_float / size_addr)
+let floatarray_header len =
+ (* Zero-sized float arrays have tag zero for consistency with
+ [caml_alloc_float_array]. *)
+ assert (len >= 0);
+ if len = 0 then block_header 0 0
+ else block_header Obj.double_array_tag (len * size_float / size_addr)
+let string_header len =
+ block_header Obj.string_tag ((len + size_addr) / size_addr)
+let boxedint32_header = block_header Obj.custom_tag 2
+let boxedint64_header = block_header Obj.custom_tag (1 + 8 / size_addr)
+let boxedintnat_header = block_header Obj.custom_tag 2
+let caml_nativeint_ops = "caml_nativeint_ops"
+let caml_int32_ops = "caml_int32_ops"
+let caml_int64_ops = "caml_int64_ops"
+
+
+let alloc_float_header dbg = Cblockheader (float_header, dbg)
+let alloc_floatarray_header len dbg = Cblockheader (floatarray_header len, dbg)
+let alloc_closure_header sz dbg = Cblockheader (white_closure_header sz, dbg)
+let alloc_infix_header ofs dbg = Cblockheader (infix_header ofs, dbg)
+let alloc_boxedint32_header dbg = Cblockheader (boxedint32_header, dbg)
+let alloc_boxedint64_header dbg = Cblockheader (boxedint64_header, dbg)
+let alloc_boxedintnat_header dbg = Cblockheader (boxedintnat_header, dbg)
+
+(* Integers *)
+
+let max_repr_int = max_int asr 1
+let min_repr_int = min_int asr 1
+
+let int_const dbg n =
+ if n <= max_repr_int && n >= min_repr_int
+ then Cconst_int((n lsl 1) + 1, dbg)
+ else Cconst_natint
+ (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n, dbg)
+
+let natint_const_untagged dbg n =
+ if n > Nativeint.of_int max_int
+ || n < Nativeint.of_int min_int
+ then Cconst_natint (n,dbg)
+ else Cconst_int (Nativeint.to_int n, dbg)
+
+let cint_const n =
+ Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n)
+
+let targetint_const n =
+ Targetint.add (Targetint.shift_left (Targetint.of_int n) 1)
+ Targetint.one
+
+let add_no_overflow n x c dbg =
+ let d = n + x in
+ if d = 0 then c else Cop(Caddi, [c; Cconst_int (d, dbg)], dbg)
+
+let rec add_const c n dbg =
+ if n = 0 then c
+ else match c with
+ | Cconst_int (x, _) when Misc.no_overflow_add x n -> Cconst_int (x + n, dbg)
+ | Cop(Caddi, [Cconst_int (x, _); c], _)
+ when Misc.no_overflow_add n x ->
+ add_no_overflow n x c dbg
+ | Cop(Caddi, [c; Cconst_int (x, _)], _)
+ when Misc.no_overflow_add n x ->
+ add_no_overflow n x c dbg
+ | Cop(Csubi, [Cconst_int (x, _); c], _) when Misc.no_overflow_add n x ->
+ Cop(Csubi, [Cconst_int (n + x, dbg); c], dbg)
+ | Cop(Csubi, [c; Cconst_int (x, _)], _) when Misc.no_overflow_sub n x ->
+ add_const c (n - x) dbg
+ | c -> Cop(Caddi, [c; Cconst_int (n, dbg)], dbg)
+
+let incr_int c dbg = add_const c 1 dbg
+let decr_int c dbg = add_const c (-1) dbg
+
+let rec add_int c1 c2 dbg =
+ match (c1, c2) with
+ | (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) ->
+ add_const c n dbg
+ | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) ->
+ add_const (add_int c1 c2 dbg) n1 dbg
+ | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) ->
+ add_const (add_int c1 c2 dbg) n2 dbg
+ | (_, _) ->
+ Cop(Caddi, [c1; c2], dbg)
+
+let rec sub_int c1 c2 dbg =
+ match (c1, c2) with
+ | (c1, Cconst_int (n2, _)) when n2 <> min_int ->
+ add_const c1 (-n2) dbg
+ | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) when n2 <> min_int ->
+ add_const (sub_int c1 c2 dbg) (-n2) dbg
+ | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) ->
+ add_const (sub_int c1 c2 dbg) n1 dbg
+ | (c1, c2) ->
+ Cop(Csubi, [c1; c2], dbg)
+
+let rec lsl_int c1 c2 dbg =
+ match (c1, c2) with
+ | (Cop(Clsl, [c; Cconst_int (n1, _)], _), Cconst_int (n2, _))
+ when n1 > 0 && n2 > 0 && n1 + n2 < size_int * 8 ->
+ Cop(Clsl, [c; Cconst_int (n1 + n2, dbg)], dbg)
+ | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), Cconst_int (n2, _))
+ when Misc.no_overflow_lsl n1 n2 ->
+ add_const (lsl_int c1 c2 dbg) (n1 lsl n2) dbg
+ | (_, _) ->
+ Cop(Clsl, [c1; c2], dbg)
+
+let is_power2 n = n = 1 lsl Misc.log2 n
+
+and mult_power2 c n dbg = lsl_int c (Cconst_int (Misc.log2 n, dbg)) dbg
+
+let rec mul_int c1 c2 dbg =
+ match (c1, c2) with
+ | (c, Cconst_int (0, _)) | (Cconst_int (0, _), c) ->
+ Csequence (c, Cconst_int (0, dbg))
+ | (c, Cconst_int (1, _)) | (Cconst_int (1, _), c) ->
+ c
+ | (c, Cconst_int(-1, _)) | (Cconst_int(-1, _), c) ->
+ sub_int (Cconst_int (0, dbg)) c dbg
+ | (c, Cconst_int (n, _)) when is_power2 n -> mult_power2 c n dbg
+ | (Cconst_int (n, _), c) when is_power2 n -> mult_power2 c n dbg
+ | (Cop(Caddi, [c; Cconst_int (n, _)], _), Cconst_int (k, _)) |
+ (Cconst_int (k, _), Cop(Caddi, [c; Cconst_int (n, _)], _))
+ when Misc.no_overflow_mul n k ->
+ add_const (mul_int c (Cconst_int (k, dbg)) dbg) (n * k) dbg
+ | (c1, c2) ->
+ Cop(Cmuli, [c1; c2], dbg)
+
+
+let ignore_low_bit_int = function
+ Cop(Caddi,
+ [(Cop(Clsl, [_; Cconst_int (n, _)], _) as c); Cconst_int (1, _)], _)
+ when n > 0
+ -> c
+ | Cop(Cor, [c; Cconst_int (1, _)], _) -> c
+ | c -> c
+
+(* removes the 1-bit sign-extension left by untag_int (tag_int c) *)
+let ignore_high_bit_int = function
+ Cop(Casr,
+ [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) -> c
+ | c -> c
+
+let lsr_int c1 c2 dbg =
+ match c2 with
+ Cconst_int (0, _) ->
+ c1
+ | Cconst_int (n, _) when n > 0 ->
+ Cop(Clsr, [ignore_low_bit_int c1; c2], dbg)
+ | _ ->
+ Cop(Clsr, [c1; c2], dbg)
+
+let asr_int c1 c2 dbg =
+ match c2 with
+ Cconst_int (0, _) ->
+ c1
+ | Cconst_int (n, _) when n > 0 ->
+ Cop(Casr, [ignore_low_bit_int c1; c2], dbg)
+ | _ ->
+ Cop(Casr, [c1; c2], dbg)
+
+let tag_int i dbg =
+ match i with
+ Cconst_int (n, _) ->
+ int_const dbg n
+ | Cop(Casr, [c; Cconst_int (n, _)], _) when n > 0 ->
+ Cop(Cor,
+ [asr_int c (Cconst_int (n - 1, dbg)) dbg; Cconst_int (1, dbg)],
+ dbg)
+ | c ->
+ incr_int (lsl_int c (Cconst_int (1, dbg)) dbg) dbg
+
+let untag_int i dbg =
+ match i with
+ Cconst_int (n, _) -> Cconst_int(n asr 1, dbg)
+ | Cop(Cor, [Cop(Casr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _)
+ when n > 0 && n < size_int * 8 ->
+ Cop(Casr, [c; Cconst_int (n+1, dbg)], dbg)
+ | Cop(Cor, [Cop(Clsr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _)
+ when n > 0 && n < size_int * 8 ->
+ Cop(Clsr, [c; Cconst_int (n+1, dbg)], dbg)
+ | c -> asr_int c (Cconst_int (1, dbg)) dbg
+
+let mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot =
+ match cond with
+ | Cconst_int (0, _) -> ifnot
+ | Cconst_int (1, _) -> ifso
+ | _ ->
+ Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg)
+
+let mk_not dbg cmm =
+ match cmm with
+ | Cop(Caddi,
+ [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') ->
+ begin
+ match c with
+ | Cop(Ccmpi cmp, [c1; c2], dbg'') ->
+ tag_int
+ (Cop(Ccmpi (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg'
+ | Cop(Ccmpa cmp, [c1; c2], dbg'') ->
+ tag_int
+ (Cop(Ccmpa (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg'
+ | Cop(Ccmpf cmp, [c1; c2], dbg'') ->
+ tag_int
+ (Cop(Ccmpf (negate_float_comparison cmp), [c1; c2], dbg'')) dbg'
+ | _ ->
+ (* 0 -> 3, 1 -> 1 *)
+ Cop(Csubi,
+ [Cconst_int (3, dbg); Cop(Clsl, [c; Cconst_int (1, dbg)], dbg)],
+ dbg)
+ end
+ | Cconst_int (3, _) -> Cconst_int (1, dbg)
+ | Cconst_int (1, _) -> Cconst_int (3, dbg)
+ | c ->
+ (* 1 -> 3, 3 -> 1 *)
+ Cop(Csubi, [Cconst_int (4, dbg); c], dbg)
+
+
+let create_loop body dbg =
+ let cont = Lambda.next_raise_count () in
+ let call_cont = Cexit (cont, []) in
+ let body = Csequence (body, call_cont) in
+ Ccatch (Recursive, [cont, [], body, dbg], call_cont)
+
+(* Turning integer divisions into multiply-high then shift.
+ The [division_parameters] function is used in module Emit for
+ those target platforms that support this optimization. *)
+
+(* Unsigned comparison between native integers. *)
+
+let ucompare x y = Nativeint.(compare (add x min_int) (add y min_int))
+
+(* Unsigned division and modulus at type nativeint.
+ Algorithm: Hacker's Delight section 9.3 *)
+
+let udivmod n d = Nativeint.(
+ if d < 0n then
+ if ucompare n d < 0 then (0n, n) else (1n, sub n d)
+ else begin
+ let q = shift_left (div (shift_right_logical n 1) d) 1 in
+ let r = sub n (mul q d) in
+ if ucompare r d >= 0 then (succ q, sub r d) else (q, r)
+ end)
+
+(* Compute division parameters.
+ Algorithm: Hacker's Delight chapter 10, fig 10-1. *)
+
+let divimm_parameters d = Nativeint.(
+ assert (d > 0n);
+ let twopsm1 = min_int in (* 2^31 for 32-bit archs, 2^63 for 64-bit archs *)
+ let nc = sub (pred twopsm1) (snd (udivmod twopsm1 d)) in
+ let rec loop p (q1, r1) (q2, r2) =
+ let p = p + 1 in
+ let q1 = shift_left q1 1 and r1 = shift_left r1 1 in
+ let (q1, r1) =
+ if ucompare r1 nc >= 0 then (succ q1, sub r1 nc) else (q1, r1) in
+ let q2 = shift_left q2 1 and r2 = shift_left r2 1 in
+ let (q2, r2) =
+ if ucompare r2 d >= 0 then (succ q2, sub r2 d) else (q2, r2) in
+ let delta = sub d r2 in
+ if ucompare q1 delta < 0 || (q1 = delta && r1 = 0n)
+ then loop p (q1, r1) (q2, r2)
+ else (succ q2, p - size)
+ in loop (size - 1) (udivmod twopsm1 nc) (udivmod twopsm1 d))
+
+(* The result [(m, p)] of [divimm_parameters d] satisfies the following
+ inequality:
+
+ 2^(wordsize + p) < m * d <= 2^(wordsize + p) + 2^(p + 1) (i)
+
+ from which it follows that
+
+ floor(n / d) = floor(n * m / 2^(wordsize+p))
+ if 0 <= n < 2^(wordsize-1)
+ ceil(n / d) = floor(n * m / 2^(wordsize+p)) + 1
+ if -2^(wordsize-1) <= n < 0
+
+ The correctness condition (i) above can be checked by the code below.
+ It was exhaustively tested for values of d from 2 to 10^9 in the
+ wordsize = 64 case.
+
+let add2 (xh, xl) (yh, yl) =
+ let zl = add xl yl and zh = add xh yh in
+ ((if ucompare zl xl < 0 then succ zh else zh), zl)
+
+let shl2 (xh, xl) n =
+ assert (0 < n && n < size + size);
+ if n < size
+ then (logor (shift_left xh n) (shift_right_logical xl (size - n)),
+ shift_left xl n)
+ else (shift_left xl (n - size), 0n)
+
+let mul2 x y =
+ let halfsize = size / 2 in
+ let halfmask = pred (shift_left 1n halfsize) in
+ let xl = logand x halfmask and xh = shift_right_logical x halfsize in
+ let yl = logand y halfmask and yh = shift_right_logical y halfsize in
+ add2 (mul xh yh, 0n)
+ (add2 (shl2 (0n, mul xl yh) halfsize)
+ (add2 (shl2 (0n, mul xh yl) halfsize)
+ (0n, mul xl yl)))
+
+let ucompare2 (xh, xl) (yh, yl) =
+ let c = ucompare xh yh in if c = 0 then ucompare xl yl else c
+
+let validate d m p =
+ let md = mul2 m d in
+ let one2 = (0n, 1n) in
+ let twoszp = shl2 one2 (size + p) in
+ let twop1 = shl2 one2 (p + 1) in
+ ucompare2 twoszp md < 0 && ucompare2 md (add2 twoszp twop1) <= 0
+*)
+
+let raise_symbol dbg symb =
+ Cop(Craise Lambda.Raise_regular, [Cconst_symbol (symb, dbg)], dbg)
+
+let rec div_int c1 c2 is_safe dbg =
+ match (c1, c2) with
+ (c1, Cconst_int (0, _)) ->
+ Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
+ | (c1, Cconst_int (1, _)) ->
+ c1
+ | (Cconst_int (n1, _), Cconst_int (n2, _)) ->
+ Cconst_int (n1 / n2, dbg)
+ | (c1, Cconst_int (n, _)) when n <> min_int ->
+ let l = Misc.log2 n in
+ if n = 1 lsl l then
+ (* Algorithm:
+ t = shift-right-signed(c1, l - 1)
+ t = shift-right(t, W - l)
+ t = c1 + t
+ res = shift-right-signed(c1 + t, l)
+ *)
+ Cop(Casr, [bind "dividend" c1 (fun c1 ->
+ let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
+ let t =
+ lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg
+ in
+ add_int c1 t dbg);
+ Cconst_int (l, dbg)], dbg)
+ else if n < 0 then
+ sub_int (Cconst_int (0, dbg))
+ (div_int c1 (Cconst_int (-n, dbg)) is_safe dbg)
+ dbg
+ else begin
+ let (m, p) = divimm_parameters (Nativeint.of_int n) in
+ (* Algorithm:
+ t = multiply-high-signed(c1, m)
+ if m < 0, t = t + c1
+ if p > 0, t = shift-right-signed(t, p)
+ res = t + sign-bit(c1)
+ *)
+ bind "dividend" c1 (fun c1 ->
+ let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in
+ let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in
+ let t =
+ if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t
+ in
+ add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1, dbg)) dbg) dbg)
+ end
+ | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
+ Cop(Cdivi, [c1; c2], dbg)
+ | (c1, c2) ->
+ bind "divisor" c2 (fun c2 ->
+ bind "dividend" c1 (fun c1 ->
+ Cifthenelse(c2,
+ dbg,
+ Cop(Cdivi, [c1; c2], dbg),
+ dbg,
+ raise_symbol dbg "caml_exn_Division_by_zero",
+ dbg)))
+
+let mod_int c1 c2 is_safe dbg =
+ match (c1, c2) with
+ (c1, Cconst_int (0, _)) ->
+ Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
+ | (c1, Cconst_int ((1 | (-1)), _)) ->
+ Csequence(c1, Cconst_int (0, dbg))
+ | (Cconst_int (n1, _), Cconst_int (n2, _)) ->
+ Cconst_int (n1 mod n2, dbg)
+ | (c1, (Cconst_int (n, _) as c2)) when n <> min_int ->
+ let l = Misc.log2 n in
+ if n = 1 lsl l then
+ (* Algorithm:
+ t = shift-right-signed(c1, l - 1)
+ t = shift-right(t, W - l)
+ t = c1 + t
+ t = bit-and(t, -n)
+ res = c1 - t
+ *)
+ bind "dividend" c1 (fun c1 ->
+ let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
+ let t = lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg in
+ let t = add_int c1 t dbg in
+ let t = Cop(Cand, [t; Cconst_int (-n, dbg)], dbg) in
+ sub_int c1 t dbg)
+ else
+ bind "dividend" c1 (fun c1 ->
+ sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2 dbg) dbg)
+ | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
+ (* Flambda already generates that test *)
+ Cop(Cmodi, [c1; c2], dbg)
+ | (c1, c2) ->
+ bind "divisor" c2 (fun c2 ->
+ bind "dividend" c1 (fun c1 ->
+ Cifthenelse(c2,
+ dbg,
+ Cop(Cmodi, [c1; c2], dbg),
+ dbg,
+ raise_symbol dbg "caml_exn_Division_by_zero",
+ dbg)))
+
+(* Division or modulo on boxed integers. The overflow case min_int / -1
+ can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)
+
+let is_different_from x = function
+ Cconst_int (n, _) -> n <> x
+ | Cconst_natint (n, _) -> n <> Nativeint.of_int x
+ | _ -> false
+
+let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg =
+ bind "dividend" c1 (fun c1 ->
+ bind "divisor" c2 (fun c2 ->
+ let c = mkop c1 c2 is_safe dbg in
+ if Arch.division_crashes_on_overflow
+ && (size_int = 4 || bi <> Primitive.Pint32)
+ && not (is_different_from (-1) c2)
+ then
+ Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int (-1, dbg)], dbg),
+ dbg, c,
+ dbg, mkm1 c1 dbg,
+ dbg)
+ else
+ c))
+
+let safe_div_bi is_safe =
+ safe_divmod_bi div_int is_safe
+ (fun c1 dbg -> Cop(Csubi, [Cconst_int (0, dbg); c1], dbg))
+
+let safe_mod_bi is_safe =
+ safe_divmod_bi mod_int is_safe (fun _ dbg -> Cconst_int (0, dbg))
+
+(* Bool *)
+
+let test_bool dbg cmm =
+ match cmm with
+ | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) ->
+ c
+ | Cconst_int (n, dbg) ->
+ if n = 1 then
+ Cconst_int (0, dbg)
+ else
+ Cconst_int (1, dbg)
+ | c -> Cop(Ccmpi Cne, [c; Cconst_int (1, dbg)], dbg)
+
+(* Float *)
+
+let box_float dbg c = Cop(Calloc, [alloc_float_header dbg; c], dbg)
+
+let unbox_float dbg =
+ map_tail
+ (function
+ | Cop(Calloc, [Cblockheader (hdr, _); c], _)
+ when Nativeint.equal hdr float_header ->
+ c
+ | Cconst_symbol (s, _dbg) as cmm ->
+ begin match Cmmgen_state.structured_constant_of_sym s with
+ | Some (Uconst_float x) ->
+ Cconst_float (x, dbg) (* or keep _dbg? *)
+ | _ ->
+ Cop(Cload (Double_u, Immutable), [cmm], dbg)
+ end
+ | cmm -> Cop(Cload (Double_u, Immutable), [cmm], dbg)
+ )
+
+(* Complex *)
+
+let box_complex dbg c_re c_im =
+ Cop(Calloc, [alloc_floatarray_header 2 dbg; c_re; c_im], dbg)
+
+let complex_re c dbg = Cop(Cload (Double_u, Immutable), [c], dbg)
+let complex_im c dbg = Cop(Cload (Double_u, Immutable),
+ [Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)],
+ dbg)
+
+(* Unit *)
+
+let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg))
+
+let rec remove_unit = function
+ Cconst_pointer (1, _) -> Ctuple []
+ | Csequence(c, Cconst_pointer (1, _)) -> c
+ | Csequence(c1, c2) ->
+ Csequence(c1, remove_unit c2)
+ | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
+ Cifthenelse(cond,
+ ifso_dbg, remove_unit ifso,
+ ifnot_dbg,
+ remove_unit ifnot, dbg)
+ | Cswitch(sel, index, cases, dbg) ->
+ Cswitch(sel, index,
+ Array.map (fun (case, dbg) -> remove_unit case, dbg) cases,
+ dbg)
+ | Ccatch(rec_flag, handlers, body) ->
+ let map_h (n, ids, handler, dbg) = (n, ids, remove_unit handler, dbg) in
+ Ccatch(rec_flag, List.map map_h handlers, remove_unit body)
+ | Ctrywith(body, exn, handler, dbg) ->
+ Ctrywith(remove_unit body, exn, remove_unit handler, dbg)
+ | Clet(id, c1, c2) ->
+ Clet(id, c1, remove_unit c2)
+ | Cop(Capply _mty, args, dbg) ->
+ Cop(Capply typ_void, args, dbg)
+ | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) ->
+ Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg)
+ | Cexit (_,_) as c -> c
+ | Ctuple [] as c -> c
+ | c -> Csequence(c, Ctuple [])
+
+(* Access to block fields *)
+
+let field_address ptr n dbg =
+ if n = 0
+ then ptr
+ else Cop(Cadda, [ptr; Cconst_int(n * size_addr, dbg)], dbg)
+
+let get_field_gen mut ptr n dbg =
+ Cop(Cload (Word_val, mut), [field_address ptr n dbg], dbg)
+
+let set_field ptr n newval init dbg =
+ Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg)
+
+let non_profinfo_mask =
+ if Config.profinfo
+ then (1 lsl (64 - Config.profinfo_width)) - 1
+ else 0 (* [non_profinfo_mask] is unused in this case *)
+
+let get_header ptr dbg =
+ (* We cannot deem this as [Immutable] due to the presence of [Obj.truncate]
+ and [Obj.set_tag]. *)
+ Cop(Cload (Word_int, Mutable),
+ [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg)
+
+let get_header_without_profinfo ptr dbg =
+ if Config.profinfo then
+ Cop(Cand, [get_header ptr dbg; Cconst_int (non_profinfo_mask, dbg)], dbg)
+ else
+ get_header ptr dbg
+
+let tag_offset =
+ if big_endian then -1 else -size_int
+
+let get_tag ptr dbg =
+ if Proc.word_addressed then (* If byte loads are slow *)
+ Cop(Cand, [get_header ptr dbg; Cconst_int (255, dbg)], dbg)
+ else (* If byte loads are efficient *)
+ (* Same comment as [get_header] above *)
+ Cop(Cload (Byte_unsigned, Mutable),
+ [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg)
+
+let get_size ptr dbg =
+ Cop(Clsr, [get_header_without_profinfo ptr dbg; Cconst_int (10, dbg)], dbg)
+
+(* Array indexing *)
+
+let log2_size_addr = Misc.log2 size_addr
+let log2_size_float = Misc.log2 size_float
+
+let wordsize_shift = 9
+let numfloat_shift = 9 + log2_size_float - log2_size_addr
+
+let is_addr_array_hdr hdr dbg =
+ Cop(Ccmpi Cne,
+ [Cop(Cand, [hdr; Cconst_int (255, dbg)], dbg); floatarray_tag dbg],
+ dbg)
+
+let is_addr_array_ptr ptr dbg =
+ Cop(Ccmpi Cne, [get_tag ptr dbg; floatarray_tag dbg], dbg)
+
+let addr_array_length_shifted hdr dbg =
+ Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg)
+let float_array_length_shifted hdr dbg =
+ Cop(Clsr, [hdr; Cconst_int (numfloat_shift, dbg)], dbg)
+
+let lsl_const c n dbg =
+ if n = 0 then c
+ else Cop(Clsl, [c; Cconst_int (n, dbg)], dbg)
+
+(* Produces a pointer to the element of the array [ptr] on the position [ofs]
+ with the given element [log2size] log2 element size. [ofs] is given as a
+ tagged int expression.
+ The optional ?typ argument is the C-- type of the result.
+ By default, it is Addr, meaning we are constructing a derived pointer
+ into the heap. If we know the pointer is outside the heap
+ (this is the case for bigarray indexing), we give type Int instead. *)
+
+let array_indexing ?typ log2size ptr ofs dbg =
+ let add =
+ match typ with
+ | None | Some Addr -> Cadda
+ | Some Int -> Caddi
+ | _ -> assert false in
+ match ofs with
+ | Cconst_int (n, _) ->
+ let i = n asr 1 in
+ if i = 0 then ptr
+ else Cop(add, [ptr; Cconst_int(i lsl log2size, dbg)], dbg)
+ | Cop(Caddi,
+ [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') ->
+ Cop(add, [ptr; lsl_const c log2size dbg], dbg')
+ | Cop(Caddi, [c; Cconst_int (n, _)], dbg') when log2size = 0 ->
+ Cop(add,
+ [Cop(add, [ptr; untag_int c dbg], dbg); Cconst_int (n asr 1, dbg)],
+ dbg')
+ | Cop(Caddi, [c; Cconst_int (n, _)], _) ->
+ Cop(add, [Cop(add, [ptr; lsl_const c (log2size - 1) dbg], dbg);
+ Cconst_int((n-1) lsl (log2size - 1), dbg)], dbg)
+ | _ when log2size = 0 ->
+ Cop(add, [ptr; untag_int ofs dbg], dbg)
+ | _ ->
+ Cop(add, [Cop(add, [ptr; lsl_const ofs (log2size - 1) dbg], dbg);
+ Cconst_int((-1) lsl (log2size - 1), dbg)], dbg)
+
+let addr_array_ref arr ofs dbg =
+ Cop(Cload (Word_val, Mutable),
+ [array_indexing log2_size_addr arr ofs dbg], dbg)
+let int_array_ref arr ofs dbg =
+ Cop(Cload (Word_int, Mutable),
+ [array_indexing log2_size_addr arr ofs dbg], dbg)
+let unboxed_float_array_ref arr ofs dbg =
+ Cop(Cload (Double_u, Mutable),
+ [array_indexing log2_size_float arr ofs dbg], dbg)
+let float_array_ref arr ofs dbg =
+ box_float dbg (unboxed_float_array_ref arr ofs dbg)
+
+let addr_array_set arr ofs newval dbg =
+ Cop(Cextcall("caml_modify", typ_void, false, None),
+ [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+let addr_array_initialize arr ofs newval dbg =
+ Cop(Cextcall("caml_initialize", typ_void, false, None),
+ [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+let int_array_set arr ofs newval dbg =
+ Cop(Cstore (Word_int, Lambda.Assignment),
+ [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+let float_array_set arr ofs newval dbg =
+ Cop(Cstore (Double_u, Lambda.Assignment),
+ [array_indexing log2_size_float arr ofs dbg; newval], dbg)
+
+(* String length *)
+
+(* Length of string block *)
+
+let string_length exp dbg =
+ bind "str" exp (fun str ->
+ let tmp_var = V.create_local "tmp" in
+ Clet(VP.create tmp_var,
+ Cop(Csubi,
+ [Cop(Clsl,
+ [get_size str dbg;
+ Cconst_int (log2_size_addr, dbg)],
+ dbg);
+ Cconst_int (1, dbg)],
+ dbg),
+ Cop(Csubi,
+ [Cvar tmp_var;
+ Cop(Cload (Byte_unsigned, Mutable),
+ [Cop(Cadda, [str; Cvar tmp_var], dbg)], dbg)], dbg)))
+
+let bigstring_length ba dbg =
+ Cop(Cload (Word_int, Mutable), [field_address ba 5 dbg], dbg)
+
+(* Message sending *)
+
+let lookup_tag obj tag dbg =
+ bind "tag" tag (fun tag ->
+ Cop(Cextcall("caml_get_public_method", typ_val, false, None),
+ [obj; tag],
+ dbg))
+
+let lookup_label obj lab dbg =
+ bind "lab" lab (fun lab ->
+ let table = Cop (Cload (Word_val, Mutable), [obj], dbg) in
+ addr_array_ref table lab dbg)
+
+let call_cached_method obj tag cache pos args dbg =
+ let arity = List.length args in
+ let cache = array_indexing log2_size_addr cache pos dbg in
+ Compilenv.need_send_fun arity;
+ Cop(Capply typ_val,
+ Cconst_symbol("caml_send" ^ Int.to_string arity, dbg) ::
+ obj :: tag :: cache :: args,
+ dbg)
+
+(* Allocation *)
+
+let make_alloc_generic set_fn dbg tag wordsize args =
+ if wordsize <= Config.max_young_wosize then
+ Cop(Calloc, Cblockheader(block_header tag wordsize, dbg) :: args, dbg)
+ else begin
+ let id = V.create_local "*alloc*" in
+ let rec fill_fields idx = function
+ [] -> Cvar id
+ | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg,
+ fill_fields (idx + 2) el) in
+ Clet(VP.create id,
+ Cop(Cextcall("caml_alloc", typ_val, true, None),
+ [Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg),
+ fill_fields 1 args)
+ end
+
+let make_alloc dbg tag args =
+ let addr_array_init arr ofs newval dbg =
+ Cop(Cextcall("caml_initialize", typ_void, false, None),
+ [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+ in
+ make_alloc_generic addr_array_init dbg tag (List.length args) args
+
+let make_float_alloc dbg tag args =
+ make_alloc_generic float_array_set dbg tag
+ (List.length args * size_float / size_addr) args
+
+(* Bounds checking *)
+
+let make_checkbound dbg = function
+ | [Cop(Clsr, [a1; Cconst_int (n, _)], _); Cconst_int (m, _)]
+ when (m lsl n) > n ->
+ Cop(Ccheckbound, [a1; Cconst_int(m lsl n + 1 lsl n - 1, dbg)], dbg)
+ | args ->
+ Cop(Ccheckbound, args, dbg)
+
+(* Record application and currying functions *)
+
+let apply_function_sym n =
+ Compilenv.need_apply_fun n; "caml_apply" ^ Int.to_string n
+let curry_function_sym n =
+ Compilenv.need_curry_fun n;
+ if n >= 0
+ then "caml_curry" ^ Int.to_string n
+ else "caml_tuplify" ^ Int.to_string (-n)
+
+(* Big arrays *)
+
+let bigarray_elt_size : Lambda.bigarray_kind -> int = function
+ Pbigarray_unknown -> assert false
+ | Pbigarray_float32 -> 4
+ | Pbigarray_float64 -> 8
+ | Pbigarray_sint8 -> 1
+ | Pbigarray_uint8 -> 1
+ | Pbigarray_sint16 -> 2
+ | Pbigarray_uint16 -> 2
+ | Pbigarray_int32 -> 4
+ | Pbigarray_int64 -> 8
+ | Pbigarray_caml_int -> size_int
+ | Pbigarray_native_int -> size_int
+ | Pbigarray_complex32 -> 8
+ | Pbigarray_complex64 -> 16
+
+(* Produces a pointer to the element of the bigarray [b] on the position
+ [args]. [args] is given as a list of tagged int expressions, one per array
+ dimension. *)
+let bigarray_indexing unsafe elt_kind layout b args dbg =
+ let check_ba_bound bound idx v =
+ Csequence(make_checkbound dbg [bound;idx], v) in
+ (* Validates the given multidimensional offset against the array bounds and
+ transforms it into a one dimensional offset. The offsets are expressions
+ evaluating to tagged int. *)
+ let rec ba_indexing dim_ofs delta_ofs = function
+ [] -> assert false
+ | [arg] ->
+ if unsafe then arg
+ else
+ bind "idx" arg (fun idx ->
+ (* Load the untagged int bound for the given dimension *)
+ let bound =
+ Cop(Cload (Word_int, Mutable),
+ [field_address b dim_ofs dbg], dbg)
+ in
+ let idxn = untag_int idx dbg in
+ check_ba_bound bound idxn idx)
+ | arg1 :: argl ->
+ (* The remainder of the list is transformed into a one dimensional offset
+ *)
+ let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in
+ (* Load the untagged int bound for the given dimension *)
+ let bound =
+ Cop(Cload (Word_int, Mutable),
+ [field_address b dim_ofs dbg], dbg)
+ in
+ if unsafe then add_int (mul_int (decr_int rem dbg) bound dbg) arg1 dbg
+ else
+ bind "idx" arg1 (fun idx ->
+ bind "bound" bound (fun bound ->
+ let idxn = untag_int idx dbg in
+ (* [offset = rem * (tag_int bound) + idx] *)
+ let offset =
+ add_int (mul_int (decr_int rem dbg) bound dbg) idx dbg
+ in
+ check_ba_bound bound idxn offset)) in
+ (* The offset as an expression evaluating to int *)
+ let offset =
+ match (layout : Lambda.bigarray_layout) with
+ Pbigarray_unknown_layout ->
+ assert false
+ | Pbigarray_c_layout ->
+ ba_indexing (4 + List.length args) (-1) (List.rev args)
+ | Pbigarray_fortran_layout ->
+ ba_indexing 5 1
+ (List.map (fun idx -> sub_int idx (Cconst_int (2, dbg)) dbg) args)
+ and elt_size =
+ bigarray_elt_size elt_kind in
+ (* [array_indexing] can simplify the given expressions *)
+ array_indexing ~typ:Addr (Misc.log2 elt_size)
+ (Cop(Cload (Word_int, Mutable),
+ [field_address b 1 dbg], dbg)) offset dbg
+
+let bigarray_word_kind : Lambda.bigarray_kind -> memory_chunk = function
+ Pbigarray_unknown -> assert false
+ | Pbigarray_float32 -> Single
+ | Pbigarray_float64 -> Double
+ | Pbigarray_sint8 -> Byte_signed
+ | Pbigarray_uint8 -> Byte_unsigned
+ | Pbigarray_sint16 -> Sixteen_signed
+ | Pbigarray_uint16 -> Sixteen_unsigned
+ | Pbigarray_int32 -> Thirtytwo_signed
+ | Pbigarray_int64 -> Word_int
+ | Pbigarray_caml_int -> Word_int
+ | Pbigarray_native_int -> Word_int
+ | Pbigarray_complex32 -> Single
+ | Pbigarray_complex64 -> Double
+
+let bigarray_get unsafe elt_kind layout b args dbg =
+ bind "ba" b (fun b ->
+ match (elt_kind : Lambda.bigarray_kind) with
+ Pbigarray_complex32 | Pbigarray_complex64 ->
+ let kind = bigarray_word_kind elt_kind in
+ let sz = bigarray_elt_size elt_kind / 2 in
+ bind "addr"
+ (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr ->
+ bind "reval"
+ (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval ->
+ bind "imval"
+ (Cop(Cload (kind, Mutable),
+ [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg)], dbg))
+ (fun imval -> box_complex dbg reval imval)))
+ | _ ->
+ Cop(Cload (bigarray_word_kind elt_kind, Mutable),
+ [bigarray_indexing unsafe elt_kind layout b args dbg],
+ dbg))
+
+let bigarray_set unsafe elt_kind layout b args newval dbg =
+ bind "ba" b (fun b ->
+ match (elt_kind : Lambda.bigarray_kind) with
+ Pbigarray_complex32 | Pbigarray_complex64 ->
+ let kind = bigarray_word_kind elt_kind in
+ let sz = bigarray_elt_size elt_kind / 2 in
+ bind "newval" newval (fun newv ->
+ bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg)
+ (fun addr ->
+ Csequence(
+ Cop(Cstore (kind, Assignment), [addr; complex_re newv dbg], dbg),
+ Cop(Cstore (kind, Assignment),
+ [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg);
+ complex_im newv dbg],
+ dbg))))
+ | _ ->
+ Cop(Cstore (bigarray_word_kind elt_kind, Assignment),
+ [bigarray_indexing unsafe elt_kind layout b args dbg; newval],
+ dbg))
+
+(* the three functions below assume either 32-bit or 64-bit words *)
+let () = assert (size_int = 4 || size_int = 8)
+
+(* low_32 x is a value which agrees with x on at least the low 32 bits *)
+let rec low_32 dbg = function
+ | x when size_int = 4 -> x
+ (* Ignore sign and zero extensions, which do not affect the low bits *)
+ | Cop(Casr, [Cop(Clsl, [x; Cconst_int (32, _)], _);
+ Cconst_int (32, _)], _)
+ | Cop(Cand, [x; Cconst_natint (0xFFFFFFFFn, _)], _) ->
+ low_32 dbg x
+ | Clet(id, e, body) ->
+ Clet(id, e, low_32 dbg body)
+ | x -> x
+
+(* sign_extend_32 sign-extends values from 32 bits to the word size.
+ (if the word size is 32, this is a no-op) *)
+let sign_extend_32 dbg e =
+ if size_int = 4 then e else
+ Cop(Casr, [Cop(Clsl, [low_32 dbg e; Cconst_int(32, dbg)], dbg);
+ Cconst_int(32, dbg)], dbg)
+
+(* zero_extend_32 zero-extends values from 32 bits to the word size.
+ (if the word size is 32, this is a no-op) *)
+let zero_extend_32 dbg e =
+ if size_int = 4 then e else
+ Cop(Cand, [low_32 dbg e; Cconst_natint(0xFFFFFFFFn, dbg)], dbg)
+
+(* Boxed integers *)
+
+let operations_boxed_int (bi : Primitive.boxed_integer) =
+ match bi with
+ Pnativeint -> caml_nativeint_ops
+ | Pint32 -> caml_int32_ops
+ | Pint64 -> caml_int64_ops
+
+let alloc_header_boxed_int (bi : Primitive.boxed_integer) =
+ match bi with
+ Pnativeint -> alloc_boxedintnat_header
+ | Pint32 -> alloc_boxedint32_header
+ | Pint64 -> alloc_boxedint64_header
+
+let box_int_gen dbg (bi : Primitive.boxed_integer) arg =
+ let arg' =
+ if bi = Primitive.Pint32 && size_int = 8 then
+ if big_endian
+ then Cop(Clsl, [arg; Cconst_int (32, dbg)], dbg)
+ else sign_extend_32 dbg arg
+ else arg
+ in
+ Cop(Calloc, [alloc_header_boxed_int bi dbg;
+ Cconst_symbol(operations_boxed_int bi, dbg);
+ arg'], dbg)
+
+let split_int64_for_32bit_target arg dbg =
+ bind "split_int64" arg (fun arg ->
+ let first = Cop (Cadda, [Cconst_int (size_int, dbg); arg], dbg) in
+ let second = Cop (Cadda, [Cconst_int (2 * size_int, dbg); arg], dbg) in
+ Ctuple [Cop (Cload (Thirtytwo_unsigned, Mutable), [first], dbg);
+ Cop (Cload (Thirtytwo_unsigned, Mutable), [second], dbg)])
+
+let alloc_matches_boxed_int bi ~hdr ~ops =
+ match (bi : Primitive.boxed_integer), hdr, ops with
+ | Pnativeint, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+ Nativeint.equal hdr boxedintnat_header
+ && String.equal sym caml_nativeint_ops
+ | Pint32, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+ Nativeint.equal hdr boxedint32_header
+ && String.equal sym caml_int32_ops
+ | Pint64, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+ Nativeint.equal hdr boxedint64_header
+ && String.equal sym caml_int64_ops
+ | (Pnativeint | Pint32 | Pint64), _, _ -> false
+
+let unbox_int dbg bi =
+ let default arg =
+ if size_int = 4 && bi = Primitive.Pint64 then
+ split_int64_for_32bit_target arg dbg
+ else
+ Cop(
+ Cload((if bi = Primitive.Pint32 then Thirtytwo_signed else Word_int),
+ Immutable),
+ [Cop(Cadda, [arg; Cconst_int (size_addr, dbg)], dbg)], dbg)
+ in
+ map_tail
+ (function
+ | Cop(Calloc,
+ [hdr; ops;
+ Cop(Clsl, [contents; Cconst_int (32, _)], _dbg')], _dbg)
+ when bi = Primitive.Pint32 && size_int = 8 && big_endian
+ && alloc_matches_boxed_int bi ~hdr ~ops ->
+ (* Force sign-extension of low 32 bits *)
+ sign_extend_32 dbg contents
+ | Cop(Calloc,
+ [hdr; ops; contents], _dbg)
+ when bi = Primitive.Pint32 && size_int = 8 && not big_endian
+ && alloc_matches_boxed_int bi ~hdr ~ops ->
+ (* Force sign-extension of low 32 bits *)
+ sign_extend_32 dbg contents
+ | Cop(Calloc, [hdr; ops; contents], _dbg)
+ when alloc_matches_boxed_int bi ~hdr ~ops ->
+ contents
+ | Cconst_symbol (s, _dbg) as cmm ->
+ begin match Cmmgen_state.structured_constant_of_sym s, bi with
+ | Some (Uconst_nativeint n), Primitive.Pnativeint ->
+ Cconst_natint (n, dbg)
+ | Some (Uconst_int32 n), Primitive.Pint32 ->
+ Cconst_natint (Nativeint.of_int32 n, dbg)
+ | Some (Uconst_int64 n), Primitive.Pint64 ->
+ if size_int = 8 then
+ Cconst_natint (Int64.to_nativeint n, dbg)
+ else
+ let low = Int64.to_nativeint n in
+ let high =
+ Int64.to_nativeint (Int64.shift_right_logical n 32)
+ in
+ if big_endian then
+ Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)]
+ else
+ Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)]
+ | _ ->
+ default cmm
+ end
+ | cmm ->
+ default cmm
+ )
+
+let make_unsigned_int bi arg dbg =
+ if bi = Primitive.Pint32 && size_int = 8
+ then zero_extend_32 dbg arg
+ else arg
+
+let unaligned_load_16 ptr idx dbg =
+ if Arch.allow_unaligned_access
+ then Cop(Cload (Sixteen_unsigned, Mutable), [add_int ptr idx dbg], dbg)
+ else
+ let cconst_int i = Cconst_int (i, dbg) in
+ let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
+ let v2 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
+ let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
+ Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg)
+
+let unaligned_set_16 ptr idx newval dbg =
+ if Arch.allow_unaligned_access
+ then
+ Cop(Cstore (Sixteen_unsigned, Assignment),
+ [add_int ptr idx dbg; newval], dbg)
+ else
+ let cconst_int i = Cconst_int (i, dbg) in
+ let v1 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg);
+ cconst_int 0xFF], dbg)
+ in
+ let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
+ let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg))
+
+let unaligned_load_32 ptr idx dbg =
+ if Arch.allow_unaligned_access
+ then Cop(Cload (Thirtytwo_unsigned, Mutable), [add_int ptr idx dbg], dbg)
+ else
+ let cconst_int i = Cconst_int (i, dbg) in
+ let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
+ let v2 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
+ in
+ let v3 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg)
+ in
+ let v4 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg)
+ in
+ let b1, b2, b3, b4 =
+ if Arch.big_endian
+ then v1, v2, v3, v4
+ else v4, v3, v2, v1 in
+ Cop(Cor,
+ [Cop(Cor, [lsl_int b1 (cconst_int 24) dbg;
+ lsl_int b2 (cconst_int 16) dbg], dbg);
+ Cop(Cor, [lsl_int b3 (cconst_int 8) dbg; b4], dbg)],
+ dbg)
+
+let unaligned_set_32 ptr idx newval dbg =
+ if Arch.allow_unaligned_access
+ then
+ Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval],
+ dbg)
+ else
+ let cconst_int i = Cconst_int (i, dbg) in
+ let v1 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg)
+ in
+ let v2 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg)
+ in
+ let v3 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg)
+ in
+ let v4 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
+ let b1, b2, b3, b4 =
+ if Arch.big_endian
+ then v1, v2, v3, v4
+ else v4, v3, v2, v1 in
+ Csequence(
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int ptr idx dbg; b1], dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
+ dbg)),
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
+ dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
+ dbg)))
+
+let unaligned_load_64 ptr idx dbg =
+ assert(size_int = 8);
+ if Arch.allow_unaligned_access
+ then Cop(Cload (Word_int, Mutable), [add_int ptr idx dbg], dbg)
+ else
+ let cconst_int i = Cconst_int (i, dbg) in
+ let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
+ let v2 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
+ let v3 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) in
+ let v4 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) in
+ let v5 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg) in
+ let v6 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg) in
+ let v7 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg) in
+ let v8 = Cop(Cload (Byte_unsigned, Mutable),
+ [add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg) in
+ let b1, b2, b3, b4, b5, b6, b7, b8 =
+ if Arch.big_endian
+ then v1, v2, v3, v4, v5, v6, v7, v8
+ else v8, v7, v6, v5, v4, v3, v2, v1 in
+ Cop(Cor,
+ [Cop(Cor,
+ [Cop(Cor, [lsl_int b1 (cconst_int (8*7)) dbg;
+ lsl_int b2 (cconst_int (8*6)) dbg], dbg);
+ Cop(Cor, [lsl_int b3 (cconst_int (8*5)) dbg;
+ lsl_int b4 (cconst_int (8*4)) dbg], dbg)],
+ dbg);
+ Cop(Cor,
+ [Cop(Cor, [lsl_int b5 (cconst_int (8*3)) dbg;
+ lsl_int b6 (cconst_int (8*2)) dbg], dbg);
+ Cop(Cor, [lsl_int b7 (cconst_int 8) dbg;
+ b8], dbg)],
+ dbg)], dbg)
+
+let unaligned_set_64 ptr idx newval dbg =
+ assert(size_int = 8);
+ if Arch.allow_unaligned_access
+ then Cop(Cstore (Word_int, Assignment), [add_int ptr idx dbg; newval], dbg)
+ else
+ let cconst_int i = Cconst_int (i, dbg) in
+ let v1 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*7)], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v2 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*6)], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v3 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*5)], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v4 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*4)], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v5 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*3)], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v6 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*2)], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v7 =
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF],
+ dbg)
+ in
+ let v8 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
+ let b1, b2, b3, b4, b5, b6, b7, b8 =
+ if Arch.big_endian
+ then v1, v2, v3, v4, v5, v6, v7, v8
+ else v8, v7, v6, v5, v4, v3, v2, v1 in
+ Csequence(
+ Csequence(
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int ptr idx dbg; b1],
+ dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
+ dbg)),
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
+ dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
+ dbg))),
+ Csequence(
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5],
+ dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6],
+ dbg)),
+ Csequence(
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7],
+ dbg),
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
+ dbg))))
+
+let max_or_zero a dbg =
+ bind "size" a (fun a ->
+ (* equivalent to
+ Cifthenelse(Cop(Ccmpi Cle, [a; cconst_int 0]), cconst_int 0, a)
+
+ if a is positive, sign is 0 hence sign_negation is full of 1
+ so sign_negation&a = a
+ if a is negative, sign is full of 1 hence sign_negation is 0
+ so sign_negation&a = 0 *)
+ let sign = Cop(Casr, [a; Cconst_int (size_int * 8 - 1, dbg)], dbg) in
+ let sign_negation = Cop(Cxor, [sign; Cconst_int (-1, dbg)], dbg) in
+ Cop(Cand, [sign_negation; a], dbg))
+
+let check_bound safety access_size dbg length a2 k =
+ match (safety : Lambda.is_safe) with
+ | Unsafe -> k
+ | Safe ->
+ let offset =
+ match (access_size : Clambda_primitives.memory_access_size) with
+ | Sixteen -> 1
+ | Thirty_two -> 3
+ | Sixty_four -> 7
+ in
+ let a1 =
+ sub_int length (Cconst_int (offset, dbg)) dbg
+ in
+ Csequence(make_checkbound dbg [max_or_zero a1 dbg; a2], k)
+
+let unaligned_set size ptr idx newval dbg =
+ match (size : Clambda_primitives.memory_access_size) with
+ | Sixteen -> unaligned_set_16 ptr idx newval dbg
+ | Thirty_two -> unaligned_set_32 ptr idx newval dbg
+ | Sixty_four -> unaligned_set_64 ptr idx newval dbg
+
+let unaligned_load size ptr idx dbg =
+ match (size : Clambda_primitives.memory_access_size) with
+ | Sixteen -> unaligned_load_16 ptr idx dbg
+ | Thirty_two -> unaligned_load_32 ptr idx dbg
+ | Sixty_four -> unaligned_load_64 ptr idx dbg
+
+let box_sized size dbg exp =
+ match (size : Clambda_primitives.memory_access_size) with
+ | Sixteen -> tag_int exp dbg
+ | Thirty_two -> box_int_gen dbg Pint32 exp
+ | Sixty_four -> box_int_gen dbg Pint64 exp
+
+(* Simplification of some primitives into C calls *)
+
+let default_prim name =
+ Primitive.simple ~name ~arity:0(*ignored*) ~alloc:true
+
+
+let int64_native_prim name arity ~alloc =
+ let u64 = Primitive.Unboxed_integer Primitive.Pint64 in
+ let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in
+ Primitive.make ~name ~native_name:(name ^ "_native")
+ ~alloc
+ ~native_repr_args:(make_args arity)
+ ~native_repr_res:u64
+
+let simplif_primitive_32bits :
+ Clambda_primitives.primitive -> Clambda_primitives.primitive = function
+ Pbintofint Pint64 -> Pccall (default_prim "caml_int64_of_int")
+ | Pintofbint Pint64 -> Pccall (default_prim "caml_int64_to_int")
+ | Pcvtbint(Pint32, Pint64) -> Pccall (default_prim "caml_int64_of_int32")
+ | Pcvtbint(Pint64, Pint32) -> Pccall (default_prim "caml_int64_to_int32")
+ | Pcvtbint(Pnativeint, Pint64) ->
+ Pccall (default_prim "caml_int64_of_nativeint")
+ | Pcvtbint(Pint64, Pnativeint) ->
+ Pccall (default_prim "caml_int64_to_nativeint")
+ | Pnegbint Pint64 -> Pccall (int64_native_prim "caml_int64_neg" 1
+ ~alloc:false)
+ | Paddbint Pint64 -> Pccall (int64_native_prim "caml_int64_add" 2
+ ~alloc:false)
+ | Psubbint Pint64 -> Pccall (int64_native_prim "caml_int64_sub" 2
+ ~alloc:false)
+ | Pmulbint Pint64 -> Pccall (int64_native_prim "caml_int64_mul" 2
+ ~alloc:false)
+ | Pdivbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_div" 2
+ ~alloc:true)
+ | Pmodbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_mod" 2
+ ~alloc:true)
+ | Pandbint Pint64 -> Pccall (int64_native_prim "caml_int64_and" 2
+ ~alloc:false)
+ | Porbint Pint64 -> Pccall (int64_native_prim "caml_int64_or" 2
+ ~alloc:false)
+ | Pxorbint Pint64 -> Pccall (int64_native_prim "caml_int64_xor" 2
+ ~alloc:false)
+ | Plslbint Pint64 -> Pccall (default_prim "caml_int64_shift_left")
+ | Plsrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right_unsigned")
+ | Pasrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right")
+ | Pbintcomp(Pint64, Lambda.Ceq) -> Pccall (default_prim "caml_equal")
+ | Pbintcomp(Pint64, Lambda.Cne) -> Pccall (default_prim "caml_notequal")
+ | Pbintcomp(Pint64, Lambda.Clt) -> Pccall (default_prim "caml_lessthan")
+ | Pbintcomp(Pint64, Lambda.Cgt) -> Pccall (default_prim "caml_greaterthan")
+ | Pbintcomp(Pint64, Lambda.Cle) -> Pccall (default_prim "caml_lessequal")
+ | Pbintcomp(Pint64, Lambda.Cge) -> Pccall (default_prim "caml_greaterequal")
+ | Pbigarrayref(_unsafe, n, Pbigarray_int64, _layout) ->
+ Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n))
+ | Pbigarrayset(_unsafe, n, Pbigarray_int64, _layout) ->
+ Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n))
+ | Pstring_load(Sixty_four, _) -> Pccall (default_prim "caml_string_get64")
+ | Pbytes_load(Sixty_four, _) -> Pccall (default_prim "caml_bytes_get64")
+ | Pbytes_set(Sixty_four, _) -> Pccall (default_prim "caml_bytes_set64")
+ | Pbigstring_load(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_get64")
+ | Pbigstring_set(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_set64")
+ | Pbbswap Pint64 -> Pccall (default_prim "caml_int64_bswap")
+ | p -> p
+
+let simplif_primitive p : Clambda_primitives.primitive =
+ match (p : Clambda_primitives.primitive) with
+ | Pduprecord _ ->
+ Pccall (default_prim "caml_obj_dup")
+ | Pbigarrayref(_unsafe, n, Pbigarray_unknown, _layout) ->
+ Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
+ | Pbigarrayset(_unsafe, n, Pbigarray_unknown, _layout) ->
+ Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
+ | Pbigarrayref(_unsafe, n, _kind, Pbigarray_unknown_layout) ->
+ Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
+ | Pbigarrayset(_unsafe, n, _kind, Pbigarray_unknown_layout) ->
+ Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
+ | p ->
+ if size_int = 8 then p else simplif_primitive_32bits p
+
+(* Build switchers both for constants and blocks *)
+
+let transl_isout h arg dbg = tag_int (Cop(Ccmpa Clt, [h ; arg], dbg)) dbg
+
+(* Build an actual switch (ie jump table) *)
+
+let make_switch arg cases actions dbg =
+ let extract_uconstant =
+ function
+ (* Constant integers loaded from a table should end in 1,
+ so that Cload never produces untagged integers *)
+ | Cconst_int (n, _), _dbg
+ | Cconst_pointer (n, _), _dbg when (n land 1) = 1 ->
+ Some (Cint (Nativeint.of_int n))
+ | Cconst_natint (n, _), _dbg
+ | Cconst_natpointer (n, _), _dbg
+ when Nativeint.(to_int (logand n one) = 1) ->
+ Some (Cint n)
+ | Cconst_symbol (s,_), _dbg ->
+ Some (Csymbol_address s)
+ | _ -> None
+ in
+ let extract_affine ~cases ~const_actions =
+ let length = Array.length cases in
+ if length >= 2
+ then begin
+ match const_actions.(cases.(0)), const_actions.(cases.(1)) with
+ | Cint v0, Cint v1 ->
+ let slope = Nativeint.sub v1 v0 in
+ let check i = function
+ | Cint v -> v = Nativeint.(add (mul (of_int i) slope) v0)
+ | _ -> false
+ in
+ if Misc.Stdlib.Array.for_alli
+ (fun i idx -> check i const_actions.(idx)) cases
+ then Some (v0, slope)
+ else None
+ | _, _ ->
+ None
+ end
+ else None
+ in
+ let make_table_lookup ~cases ~const_actions arg dbg =
+ let table = Compilenv.new_const_symbol () in
+ Cmmgen_state.add_constant table (Const_table (Local,
+ Array.to_list (Array.map (fun act ->
+ const_actions.(act)) cases)));
+ addr_array_ref (Cconst_symbol (table, dbg)) (tag_int arg dbg) dbg
+ in
+ let make_affine_computation ~offset ~slope arg dbg =
+ (* In case the resulting integers are an affine function of the index, we
+ don't emit a table, and just compute the result directly *)
+ add_int
+ (mul_int arg (natint_const_untagged dbg slope) dbg)
+ (natint_const_untagged dbg offset)
+ dbg
+ in
+ match Misc.Stdlib.Array.all_somes (Array.map extract_uconstant actions) with
+ | None ->
+ Cswitch (arg,cases,actions,dbg)
+ | Some const_actions ->
+ match extract_affine ~cases ~const_actions with
+ | Some (offset, slope) ->
+ make_affine_computation ~offset ~slope arg dbg
+ | None -> make_table_lookup ~cases ~const_actions arg dbg
+
+module SArgBlocks =
+struct
+ type primitive = operation
+
+ let eqint = Ccmpi Ceq
+ let neint = Ccmpi Cne
+ let leint = Ccmpi Cle
+ let ltint = Ccmpi Clt
+ let geint = Ccmpi Cge
+ let gtint = Ccmpi Cgt
+
+ type act = expression
+
+ (* CR mshinwell: GPR#2294 will fix the Debuginfo here *)
+
+ let make_const i = Cconst_int (i, Debuginfo.none)
+ let make_prim p args = Cop (p,args, Debuginfo.none)
+ let make_offset arg n = add_const arg n Debuginfo.none
+ let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none)
+ let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none)
+ let make_if cond ifso ifnot =
+ Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot,
+ Debuginfo.none)
+ let make_switch loc arg cases actions =
+ let dbg = Debuginfo.from_location loc in
+ let actions = Array.map (fun expr -> expr, dbg) actions in
+ make_switch arg cases actions dbg
+ let bind arg body = bind "switcher" arg body
+
+ let make_catch handler = match handler with
+ | Cexit (i,[]) -> i,fun e -> e
+ | _ ->
+ let dbg = Debuginfo.none in
+ let i = Lambda.next_raise_count () in
+(*
+ Printf.eprintf "SHARE CMM: %i\n" i ;
+ Printcmm.expression Format.str_formatter handler ;
+ Printf.eprintf "%s\n" (Format.flush_str_formatter ()) ;
+*)
+ i,
+ (fun body -> match body with
+ | Cexit (j,_) ->
+ if i=j then handler
+ else body
+ | _ -> ccatch (i,[],body,handler, dbg))
+
+ let make_exit i = Cexit (i,[])
+
+end
+
+(* cmm store, as sharing as normally been detected in previous
+ phases, we only share exits *)
+(* Some specific patterns can lead to switches where several cases
+ point to the same action, but this action is not an exit (see GPR#1370).
+ The addition of the index in the action array as context allows to
+ share them correctly without duplication. *)
+module StoreExpForSwitch =
+ Switch.CtxStore
+ (struct
+ type t = expression
+ type key = int option * int
+ type context = int
+ let make_key index expr =
+ let continuation =
+ match expr with
+ | Cexit (i,[]) -> Some i
+ | _ -> None
+ in
+ Some (continuation, index)
+ let compare_key (cont, index) (cont', index') =
+ match cont, cont' with
+ | Some i, Some i' when i = i' -> 0
+ | _, _ -> Stdlib.compare index index'
+ end)
+
+(* For string switches, we can use a generic store *)
+module StoreExp =
+ Switch.Store
+ (struct
+ type t = expression
+ type key = int
+ let make_key = function
+ | Cexit (i,[]) -> Some i
+ | _ -> None
+ let compare_key = Stdlib.compare
+ end)
+
+module SwitcherBlocks = Switch.Make(SArgBlocks)
+
+(* Int switcher, arg in [low..high],
+ cases is list of individual cases, and is sorted by first component *)
+
+let transl_int_switch loc arg low high cases default = match cases with
+| [] -> assert false
+| _::_ ->
+ let store = StoreExp.mk_store () in
+ assert (store.Switch.act_store () default = 0) ;
+ let cases =
+ List.map
+ (fun (i,act) -> i,store.Switch.act_store () act)
+ cases in
+ let rec inters plow phigh pact = function
+ | [] ->
+ if phigh = high then [plow,phigh,pact]
+ else [(plow,phigh,pact); (phigh+1,high,0) ]
+ | (i,act)::rem ->
+ if i = phigh+1 then
+ if pact = act then
+ inters plow i pact rem
+ else
+ (plow,phigh,pact)::inters i i act rem
+ else (* insert default *)
+ if pact = 0 then
+ if act = 0 then
+ inters plow i 0 rem
+ else
+ (plow,i-1,pact)::
+ inters i i act rem
+ else (* pact <> 0 *)
+ (plow,phigh,pact)::
+ begin
+ if act = 0 then inters (phigh+1) i 0 rem
+ else (phigh+1,i-1,0)::inters i i act rem
+ end in
+ let inters = match cases with
+ | [] -> assert false
+ | (k0,act0)::rem ->
+ if k0 = low then inters k0 k0 act0 rem
+ else inters low (k0-1) 0 cases in
+ bind "switcher" arg
+ (fun a ->
+ SwitcherBlocks.zyva
+ loc
+ (low,high)
+ a
+ (Array.of_list inters) store)
+
+
+let transl_switch_clambda loc arg index cases =
+ let store = StoreExpForSwitch.mk_store () in
+ let index =
+ Array.map
+ (fun j -> store.Switch.act_store j cases.(j))
+ index in
+ let n_index = Array.length index in
+ let inters = ref []
+ and this_high = ref (n_index-1)
+ and this_low = ref (n_index-1)
+ and this_act = ref index.(n_index-1) in
+ for i = n_index-2 downto 0 do
+ let act = index.(i) in
+ if act = !this_act then
+ decr this_low
+ else begin
+ inters := (!this_low, !this_high, !this_act) :: !inters ;
+ this_high := i ;
+ this_low := i ;
+ this_act := act
+ end
+ done ;
+ inters := (0, !this_high, !this_act) :: !inters ;
+ match !inters with
+ | [_] -> cases.(0)
+ | inters ->
+ bind "switcher" arg
+ (fun a ->
+ SwitcherBlocks.zyva
+ loc
+ (0,n_index-1)
+ a
+ (Array.of_list inters) store)
+
+let strmatch_compile =
+ let module S =
+ Strmatch.Make
+ (struct
+ let string_block_length ptr = get_size ptr Debuginfo.none
+ let transl_switch = transl_int_switch
+ end) in
+ S.compile
+
+let ptr_offset ptr offset dbg =
+ if offset = 0
+ then ptr
+ else Cop(Caddv, [ptr; Cconst_int(offset * size_addr, dbg)], dbg)
+
+let direct_apply lbl args dbg =
+ Cop(Capply typ_val, Cconst_symbol (lbl, dbg) :: args, dbg)
+
+let generic_apply mut clos args dbg =
+ match args with
+ | [arg] ->
+ bind "fun" clos (fun clos ->
+ Cop(Capply typ_val, [get_field_gen mut clos 0 dbg; arg; clos],
+ dbg))
+ | _ ->
+ let arity = List.length args in
+ let cargs =
+ Cconst_symbol(apply_function_sym arity, dbg) :: args @ [clos]
+ in
+ Cop(Capply typ_val, cargs, dbg)
+
+let send kind met obj args dbg =
+ let call_met obj args clos =
+ (* met is never a simple expression, so it never gets turned into an
+ Immutable load *)
+ generic_apply Asttypes.Mutable clos (obj :: args) dbg
+ in
+ bind "obj" obj (fun obj ->
+ match (kind : Lambda.meth_kind), args with
+ Self, _ ->
+ bind "met" (lookup_label obj met dbg)
+ (call_met obj args)
+ | Cached, cache :: pos :: args ->
+ call_cached_method obj met cache pos args dbg
+ | _ ->
+ bind "met" (lookup_tag obj met dbg)
+ (call_met obj args))
+
+(*
+CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
+{
+ int li = 3, hi = Field(meths,0), mi;
+ while (li < hi) { // no need to check the 1st time
+ mi = ((li+hi) >> 1) | 1;
+ if (tag < Field(meths,mi)) hi = mi-2;
+ else li = mi;
+ }
+ *cache = (li-3)*sizeof(value)+1;
+ return Field (meths, li-1);
+}
+*)
+
+let cache_public_method meths tag cache dbg =
+ let raise_num = Lambda.next_raise_count () in
+ let cconst_int i = Cconst_int (i, dbg) in
+ let li = V.create_local "*li*" and hi = V.create_local "*hi*"
+ and mi = V.create_local "*mi*" and tagged = V.create_local "*tagged*" in
+ Clet (
+ VP.create li, cconst_int 3,
+ Clet (
+ VP.create hi, Cop(Cload (Word_int, Mutable), [meths], dbg),
+ Csequence(
+ ccatch
+ (raise_num, [],
+ create_loop
+ (Clet(
+ VP.create mi,
+ Cop(Cor,
+ [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi], dbg); cconst_int 1],
+ dbg);
+ cconst_int 1],
+ dbg),
+ Csequence(
+ Cifthenelse
+ (Cop (Ccmpi Clt,
+ [tag;
+ Cop(Cload (Word_int, Mutable),
+ [Cop(Cadda,
+ [meths; lsl_const (Cvar mi) log2_size_addr dbg],
+ dbg)],
+ dbg)], dbg),
+ dbg, Cassign(hi, Cop(Csubi, [Cvar mi; cconst_int 2], dbg)),
+ dbg, Cassign(li, Cvar mi),
+ dbg),
+ Cifthenelse
+ (Cop(Ccmpi Cge, [Cvar li; Cvar hi], dbg),
+ dbg, Cexit (raise_num, []),
+ dbg, Ctuple [],
+ dbg))))
+ dbg,
+ Ctuple [],
+ dbg),
+ Clet (
+ VP.create tagged,
+ Cop(Cadda, [lsl_const (Cvar li) log2_size_addr dbg;
+ cconst_int(1 - 3 * size_addr)], dbg),
+ Csequence(Cop (Cstore (Word_int, Assignment), [cache; Cvar tagged], dbg),
+ Cvar tagged)))))
+
+(* CR mshinwell: These will be filled in by later pull requests. *)
+let placeholder_dbg () = Debuginfo.none
+let placeholder_fun_dbg ~human_name:_ = Debuginfo.none
+
+(* Generate an application function:
+ (defun caml_applyN (a1 ... aN clos)
+ (if (= clos.arity N)
+ (app clos.direct a1 ... aN clos)
+ (let (clos1 (app clos.code a1 clos)
+ clos2 (app clos1.code a2 clos)
+ ...
+ closN-1 (app closN-2.code aN-1 closN-2))
+ (app closN-1.code aN closN-1))))
+*)
+
+let apply_function_body arity =
+ let dbg = placeholder_dbg in
+ let arg = Array.make arity (V.create_local "arg") in
+ for i = 1 to arity - 1 do arg.(i) <- V.create_local "arg" done;
+ let clos = V.create_local "clos" in
+ let rec app_fun clos n =
+ if n = arity-1 then
+ Cop(Capply typ_val,
+ [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ());
+ Cvar arg.(n);
+ Cvar clos],
+ dbg ())
+ else begin
+ let newclos = V.create_local "clos" in
+ Clet(VP.create newclos,
+ Cop(Capply typ_val,
+ [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ());
+ Cvar arg.(n); Cvar clos], dbg ()),
+ app_fun newclos (n+1))
+ end in
+ let args = Array.to_list arg in
+ let all_args = args @ [clos] in
+ (args, clos,
+ if arity = 1 then app_fun clos 0 else
+ Cifthenelse(
+ Cop(Ccmpi Ceq, [get_field_gen Asttypes.Mutable (Cvar clos) 1 (dbg ());
+ int_const (dbg ()) arity], dbg ()),
+ dbg (),
+ Cop(Capply typ_val,
+ get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
+ :: List.map (fun s -> Cvar s) all_args,
+ dbg ()),
+ dbg (),
+ app_fun clos 0,
+ dbg ()))
+
+let send_function arity =
+ let dbg = placeholder_dbg in
+ let cconst_int i = Cconst_int (i, dbg ()) in
+ let (args, clos', body) = apply_function_body (1+arity) in
+ let cache = V.create_local "cache"
+ and obj = List.hd args
+ and tag = V.create_local "tag" in
+ let clos =
+ let cache = Cvar cache and obj = Cvar obj and tag = Cvar tag in
+ let meths = V.create_local "meths" and cached = V.create_local "cached" in
+ let real = V.create_local "real" in
+ let mask = get_field_gen Asttypes.Mutable (Cvar meths) 1 (dbg ()) in
+ let cached_pos = Cvar cached in
+ let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths], dbg ());
+ cconst_int(3*size_addr-1)], dbg ()) in
+ let tag' = Cop(Cload (Word_int, Mutable), [tag_pos], dbg ()) in
+ Clet (
+ VP.create meths, Cop(Cload (Word_val, Mutable), [obj], dbg ()),
+ Clet (
+ VP.create cached,
+ Cop(Cand, [Cop(Cload (Word_int, Mutable), [cache], dbg ()); mask],
+ dbg ()),
+ Clet (
+ VP.create real,
+ Cifthenelse(Cop(Ccmpa Cne, [tag'; tag], dbg ()),
+ dbg (),
+ cache_public_method (Cvar meths) tag cache (dbg ()),
+ dbg (),
+ cached_pos,
+ dbg ()),
+ Cop(Cload (Word_val, Mutable),
+ [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths], dbg ());
+ cconst_int(2*size_addr-1)], dbg ())], dbg ()))))
+
+ in
+ let body = Clet(VP.create clos', clos, body) in
+ let cache = cache in
+ let fun_name = "caml_send" ^ Int.to_string arity in
+ let fun_args =
+ [obj, typ_val; tag, typ_int; cache, typ_val]
+ @ List.map (fun id -> (id, typ_val)) (List.tl args) in
+ let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+ Cfunction
+ {fun_name;
+ fun_args = List.map (fun (arg, ty) -> VP.create arg, ty) fun_args;
+ fun_body = body;
+ fun_codegen_options = [];
+ fun_dbg;
+ }
+
+let apply_function arity =
+ let (args, clos, body) = apply_function_body arity in
+ let all_args = args @ [clos] in
+ let fun_name = "caml_apply" ^ Int.to_string arity in
+ let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+ Cfunction
+ {fun_name;
+ fun_args = List.map (fun arg -> (VP.create arg, typ_val)) all_args;
+ fun_body = body;
+ fun_codegen_options = [];
+ fun_dbg;
+ }
+
+(* Generate tuplifying functions:
+ (defun caml_tuplifyN (arg clos)
+ (app clos.direct #0(arg) ... #N-1(arg) clos)) *)
+
+let tuplify_function arity =
+ let dbg = placeholder_dbg in
+ let arg = V.create_local "arg" in
+ let clos = V.create_local "clos" in
+ let rec access_components i =
+ if i >= arity
+ then []
+ else get_field_gen Asttypes.Mutable (Cvar arg) i (dbg ())
+ :: access_components(i+1)
+ in
+ let fun_name = "caml_tuplify" ^ Int.to_string arity in
+ let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+ Cfunction
+ {fun_name;
+ fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
+ fun_body =
+ Cop(Capply typ_val,
+ get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
+ :: access_components 0 @ [Cvar clos],
+ (dbg ()));
+ fun_codegen_options = [];
+ fun_dbg;
+ }
+
+(* Generate currying functions:
+ (defun caml_curryN (arg clos)
+ (alloc HDR caml_curryN_1 <arity (N-1)> caml_curry_N_1_app arg clos))
+ (defun caml_curryN_1 (arg clos)
+ (alloc HDR caml_curryN_2 <arity (N-2)> caml_curry_N_2_app arg clos))
+ ...
+ (defun caml_curryN_N-1 (arg clos)
+ (let (closN-2 clos.vars[1]
+ closN-3 closN-2.vars[1]
+ ...
+ clos1 clos2.vars[1]
+ clos clos1.vars[1])
+ (app clos.direct
+ clos1.vars[0] ... closN-2.vars[0] clos.vars[0] arg clos)))
+
+ Special "shortcut" functions are also generated to handle the
+ case where a partially applied function is applied to all remaining
+ arguments in one go. For instance:
+ (defun caml_curry_N_1_app (arg2 ... argN clos)
+ (let clos' clos.vars[1]
+ (app clos'.direct clos.vars[0] arg2 ... argN clos')))
+
+ Those shortcuts may lead to a quadratic number of application
+ primitives being generated in the worst case, which resulted in
+ linking time blowup in practice (PR#5933), so we only generate and
+ use them when below a fixed arity 'max_arity_optimized'.
+*)
+
+let max_arity_optimized = 15
+let final_curry_function arity =
+ let dbg = placeholder_dbg in
+ let last_arg = V.create_local "arg" in
+ let last_clos = V.create_local "clos" in
+ let rec curry_fun args clos n =
+ if n = 0 then
+ Cop(Capply typ_val,
+ get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) ::
+ args @ [Cvar last_arg; Cvar clos],
+ dbg ())
+ else
+ if n = arity - 1 || arity > max_arity_optimized then
+ begin
+ let newclos = V.create_local "clos" in
+ Clet(VP.create newclos,
+ get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()),
+ curry_fun (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
+ :: args)
+ newclos (n-1))
+ end else
+ begin
+ let newclos = V.create_local "clos" in
+ Clet(VP.create newclos,
+ get_field_gen Asttypes.Mutable (Cvar clos) 4 (dbg ()),
+ curry_fun
+ (get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()) :: args)
+ newclos (n-1))
+ end in
+ let fun_name =
+ "caml_curry" ^ Int.to_string arity ^ "_" ^ Int.to_string (arity-1)
+ in
+ let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+ Cfunction
+ {fun_name;
+ fun_args = [VP.create last_arg, typ_val; VP.create last_clos, typ_val];
+ fun_body = curry_fun [] last_clos (arity-1);
+ fun_codegen_options = [];
+ fun_dbg;
+ }
+
+let rec intermediate_curry_functions arity num =
+ let dbg = placeholder_dbg in
+ if num = arity - 1 then
+ [final_curry_function arity]
+ else begin
+ let name1 = "caml_curry" ^ Int.to_string arity in
+ let name2 = if num = 0 then name1 else name1 ^ "_" ^ Int.to_string num in
+ let arg = V.create_local "arg" and clos = V.create_local "clos" in
+ let fun_dbg = placeholder_fun_dbg ~human_name:name2 in
+ Cfunction
+ {fun_name = name2;
+ fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
+ fun_body =
+ if arity - num > 2 && arity <= max_arity_optimized then
+ Cop(Calloc,
+ [alloc_closure_header 5 (dbg ());
+ Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
+ int_const (dbg ()) (arity - num - 1);
+ Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1) ^ "_app",
+ dbg ());
+ Cvar arg; Cvar clos],
+ dbg ())
+ else
+ Cop(Calloc,
+ [alloc_closure_header 4 (dbg ());
+ Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
+ int_const (dbg ()) 1; Cvar arg; Cvar clos],
+ dbg ());
+ fun_codegen_options = [];
+ fun_dbg;
+ }
+ ::
+ (if arity <= max_arity_optimized && arity - num > 2 then
+ let rec iter i =
+ if i <= arity then
+ let arg = V.create_local (Printf.sprintf "arg%d" i) in
+ (arg, typ_val) :: iter (i+1)
+ else []
+ in
+ let direct_args = iter (num+2) in
+ let rec iter i args clos =
+ if i = 0 then
+ Cop(Capply typ_val,
+ (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()))
+ :: args @ [Cvar clos],
+ dbg ())
+ else
+ let newclos = V.create_local "clos" in
+ Clet(VP.create newclos,
+ get_field_gen Asttypes.Mutable (Cvar clos) 4 (dbg ()),
+ iter (i-1)
+ (get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ())
+ :: args)
+ newclos)
+ in
+ let fun_args =
+ List.map (fun (arg, ty) -> VP.create arg, ty)
+ (direct_args @ [clos, typ_val])
+ in
+ let fun_name = name1 ^ "_" ^ Int.to_string (num+1) ^ "_app" in
+ let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+ let cf =
+ Cfunction
+ {fun_name;
+ fun_args;
+ fun_body = iter (num+1)
+ (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
+ fun_codegen_options = [];
+ fun_dbg;
+ }
+ in
+ cf :: intermediate_curry_functions arity (num+1)
+ else
+ intermediate_curry_functions arity (num+1))
+ end
+
+let curry_function arity =
+ assert(arity <> 0);
+ (* Functions with arity = 0 does not have a curry_function *)
+ if arity > 0
+ then intermediate_curry_functions arity 0
+ else [tuplify_function (-arity)]
+
+module Int = Numbers.Int
+
+let default_apply = Int.Set.add 2 (Int.Set.add 3 Int.Set.empty)
+ (* These apply funs are always present in the main program because
+ the run-time system needs them (cf. runtime/<arch>.S) . *)
+
+let generic_functions shared units =
+ let (apply,send,curry) =
+ List.fold_left
+ (fun (apply,send,curry) (ui : Cmx_format.unit_infos) ->
+ List.fold_right Int.Set.add ui.ui_apply_fun apply,
+ List.fold_right Int.Set.add ui.ui_send_fun send,
+ List.fold_right Int.Set.add ui.ui_curry_fun curry)
+ (Int.Set.empty,Int.Set.empty,Int.Set.empty)
+ units in
+ let apply = if shared then apply else Int.Set.union apply default_apply in
+ let accu = Int.Set.fold (fun n accu -> apply_function n :: accu) apply [] in
+ let accu = Int.Set.fold (fun n accu -> send_function n :: accu) send accu in
+ Int.Set.fold (fun n accu -> curry_function n @ accu) curry accu
+
+(* Primitives *)
+
+type unary_primitive = expression -> Debuginfo.t -> expression
+
+let floatfield n ptr dbg =
+ Cop(Cload (Double_u, Mutable),
+ [if n = 0 then ptr
+ else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)],
+ dbg)
+
+let int_as_pointer arg dbg =
+ Cop(Caddi, [arg; Cconst_int (-1, dbg)], dbg)
+ (* always a pointer outside the heap *)
+
+let raise_prim raise_kind arg dbg =
+ if !Clflags.debug then
+ Cop (Craise raise_kind, [arg], dbg)
+ else
+ Cop (Craise Lambda.Raise_notrace, [arg], dbg)
+
+let negint arg dbg =
+ Cop(Csubi, [Cconst_int (2, dbg); arg], dbg)
+
+(* [offsetint] moved down to reuse add_int_caml *)
+
+let offsetref n arg dbg =
+ return_unit dbg
+ (bind "ref" arg (fun arg ->
+ Cop(Cstore (Word_int, Assignment),
+ [arg;
+ add_const (Cop(Cload (Word_int, Mutable), [arg], dbg))
+ (n lsl 1) dbg],
+ dbg)))
+
+let arraylength kind arg dbg =
+ let hdr = get_header_without_profinfo arg dbg in
+ match (kind : Lambda.array_kind) with
+ Pgenarray ->
+ let len =
+ if wordsize_shift = numfloat_shift then
+ Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg)
+ else
+ bind "header" hdr (fun hdr ->
+ Cifthenelse(is_addr_array_hdr hdr dbg,
+ dbg,
+ Cop(Clsr,
+ [hdr; Cconst_int (wordsize_shift, dbg)], dbg),
+ dbg,
+ Cop(Clsr,
+ [hdr; Cconst_int (numfloat_shift, dbg)], dbg),
+ dbg))
+ in
+ Cop(Cor, [len; Cconst_int (1, dbg)], dbg)
+ | Paddrarray | Pintarray ->
+ Cop(Cor, [addr_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
+ | Pfloatarray ->
+ Cop(Cor, [float_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
+
+let bbswap bi arg dbg =
+ let prim = match (bi : Primitive.boxed_integer) with
+ | Pnativeint -> "nativeint"
+ | Pint32 -> "int32"
+ | Pint64 -> "int64"
+ in
+ Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim,
+ typ_int, false, None),
+ [arg],
+ dbg)
+
+let bswap16 arg dbg =
+ (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None),
+ [arg],
+ dbg))
+
+type binary_primitive = expression -> expression -> Debuginfo.t -> expression
+
+(* let pfield_computed = addr_array_ref *)
+
+(* Helper for compilation of initialization and assignment operations *)
+
+type assignment_kind = Caml_modify | Caml_initialize | Simple
+
+let assignment_kind
+ (ptr: Lambda.immediate_or_pointer)
+ (init: Lambda.initialization_or_assignment) =
+ match init, ptr with
+ | Assignment, Pointer -> Caml_modify
+ | Heap_initialization, Pointer -> Caml_initialize
+ | Assignment, Immediate
+ | Heap_initialization, Immediate
+ | Root_initialization, (Immediate | Pointer) -> Simple
+
+let setfield n ptr init arg1 arg2 dbg =
+ match assignment_kind ptr init with
+ | Caml_modify ->
+ return_unit dbg (Cop(Cextcall("caml_modify", typ_void, false, None),
+ [field_address arg1 n dbg;
+ arg2],
+ dbg))
+ | Caml_initialize ->
+ return_unit dbg (Cop(Cextcall("caml_initialize", typ_void, false, None),
+ [field_address arg1 n dbg;
+ arg2],
+ dbg))
+ | Simple ->
+ return_unit dbg (set_field arg1 n arg2 init dbg)
+
+let setfloatfield n init arg1 arg2 dbg =
+ return_unit dbg (
+ Cop(Cstore (Double_u, init),
+ [if n = 0 then arg1
+ else Cop(Cadda, [arg1; Cconst_int(n * size_float, dbg)], dbg);
+ arg2], dbg))
+
+let add_int_caml arg1 arg2 dbg =
+ decr_int (add_int arg1 arg2 dbg) dbg
+
+(* Unary primitive delayed to reuse add_int_caml *)
+let offsetint n arg dbg =
+ if Misc.no_overflow_lsl n 1 then
+ add_const arg (n lsl 1) dbg
+ else
+ add_int_caml arg (int_const dbg n) dbg
+
+let sub_int_caml arg1 arg2 dbg =
+ incr_int (sub_int arg1 arg2 dbg) dbg
+
+let mul_int_caml arg1 arg2 dbg =
+ (* decrementing the non-constant part helps when the multiplication is
+ followed by an addition;
+ for example, using this trick compiles (100 * a + 7) into
+ (+ ( * a 100) -85)
+ rather than
+ (+ ( * 200 (>>s a 1)) 15)
+ *)
+ match arg1, arg2 with
+ | Cconst_int _ as c1, c2 ->
+ incr_int (mul_int (untag_int c1 dbg) (decr_int c2 dbg) dbg) dbg
+ | c1, c2 ->
+ incr_int (mul_int (decr_int c1 dbg) (untag_int c2 dbg) dbg) dbg
+
+let div_int_caml is_safe arg1 arg2 dbg =
+ tag_int(div_int (untag_int arg1 dbg)
+ (untag_int arg2 dbg) is_safe dbg) dbg
+
+let mod_int_caml is_safe arg1 arg2 dbg =
+ tag_int(mod_int (untag_int arg1 dbg)
+ (untag_int arg2 dbg) is_safe dbg) dbg
+
+let and_int_caml arg1 arg2 dbg =
+ Cop(Cand, [arg1; arg2], dbg)
+
+let or_int_caml arg1 arg2 dbg =
+ Cop(Cor, [arg1; arg2], dbg)
+
+let xor_int_caml arg1 arg2 dbg =
+ Cop(Cor, [Cop(Cxor, [ignore_low_bit_int arg1;
+ ignore_low_bit_int arg2], dbg);
+ Cconst_int (1, dbg)], dbg)
+
+let lsl_int_caml arg1 arg2 dbg =
+ incr_int(lsl_int (decr_int arg1 dbg)
+ (untag_int arg2 dbg) dbg) dbg
+
+let lsr_int_caml arg1 arg2 dbg =
+ Cop(Cor, [lsr_int arg1 (untag_int arg2 dbg) dbg;
+ Cconst_int (1, dbg)], dbg)
+
+let asr_int_caml arg1 arg2 dbg =
+ Cop(Cor, [asr_int arg1 (untag_int arg2 dbg) dbg;
+ Cconst_int (1, dbg)], dbg)
+
+let int_comp_caml cmp arg1 arg2 dbg =
+ tag_int(Cop(Ccmpi cmp,
+ [arg1; arg2], dbg)) dbg
+
+let stringref_unsafe arg1 arg2 dbg =
+ tag_int(Cop(Cload (Byte_unsigned, Mutable),
+ [add_int arg1 (untag_int arg2 dbg) dbg],
+ dbg)) dbg
+
+let stringref_safe arg1 arg2 dbg =
+ tag_int
+ (bind "str" arg1 (fun str ->
+ bind "index" (untag_int arg2 dbg) (fun idx ->
+ Csequence(
+ make_checkbound dbg [string_length str dbg; idx],
+ Cop(Cload (Byte_unsigned, Mutable),
+ [add_int str idx dbg], dbg))))) dbg
+
+let string_load size unsafe arg1 arg2 dbg =
+ box_sized size dbg
+ (bind "str" arg1 (fun str ->
+ bind "index" (untag_int arg2 dbg) (fun idx ->
+ check_bound unsafe size dbg
+ (string_length str dbg)
+ idx (unaligned_load size str idx dbg))))
+
+let bigstring_load size unsafe arg1 arg2 dbg =
+ box_sized size dbg
+ (bind "ba" arg1 (fun ba ->
+ bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "ba_data"
+ (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
+ (fun ba_data ->
+ check_bound unsafe size dbg
+ (bigstring_length ba dbg)
+ idx
+ (unaligned_load size ba_data idx dbg)))))
+
+let arrayref_unsafe kind arg1 arg2 dbg =
+ match (kind : Lambda.array_kind) with
+ | Pgenarray ->
+ bind "arr" arg1 (fun arr ->
+ bind "index" arg2 (fun idx ->
+ Cifthenelse(is_addr_array_ptr arr dbg,
+ dbg,
+ addr_array_ref arr idx dbg,
+ dbg,
+ float_array_ref arr idx dbg,
+ dbg)))
+ | Paddrarray ->
+ addr_array_ref arg1 arg2 dbg
+ | Pintarray ->
+ (* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *)
+ int_array_ref arg1 arg2 dbg
+ | Pfloatarray ->
+ float_array_ref arg1 arg2 dbg
+
+let arrayref_safe kind arg1 arg2 dbg =
+ match (kind : Lambda.array_kind) with
+ | Pgenarray ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
+ if wordsize_shift = numfloat_shift then
+ Csequence(
+ make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+ Cifthenelse(is_addr_array_hdr hdr dbg,
+ dbg,
+ addr_array_ref arr idx dbg,
+ dbg,
+ float_array_ref arr idx dbg,
+ dbg))
+ else
+ Cifthenelse(is_addr_array_hdr hdr dbg,
+ dbg,
+ Csequence(
+ make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+ addr_array_ref arr idx dbg),
+ dbg,
+ Csequence(
+ make_checkbound dbg [float_array_length_shifted hdr dbg; idx],
+ float_array_ref arr idx dbg),
+ dbg))))
+ | Paddrarray ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ Csequence(
+ make_checkbound dbg [
+ addr_array_length_shifted
+ (get_header_without_profinfo arr dbg) dbg; idx],
+ addr_array_ref arr idx dbg)))
+ | Pintarray ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ Csequence(
+ make_checkbound dbg [
+ addr_array_length_shifted
+ (get_header_without_profinfo arr dbg) dbg; idx],
+ int_array_ref arr idx dbg)))
+ | Pfloatarray ->
+ box_float dbg (
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ Csequence(
+ make_checkbound dbg [
+ float_array_length_shifted
+ (get_header_without_profinfo arr dbg) dbg;
+ idx],
+ unboxed_float_array_ref arr idx dbg))))
+
+type ternary_primitive =
+ expression -> expression -> expression -> Debuginfo.t -> expression
+
+let setfield_computed ptr init arg1 arg2 arg3 dbg =
+ match assignment_kind ptr init with
+ | Caml_modify ->
+ return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
+ | Caml_initialize ->
+ return_unit dbg (addr_array_initialize arg1 arg2 arg3 dbg)
+ | Simple ->
+ return_unit dbg (int_array_set arg1 arg2 arg3 dbg)
+
+let bytesset_unsafe arg1 arg2 arg3 dbg =
+ return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int arg1 (untag_int arg2 dbg) dbg;
+ ignore_high_bit_int (untag_int arg3 dbg)], dbg))
+
+let bytesset_safe arg1 arg2 arg3 dbg =
+ return_unit dbg
+ (bind "str" arg1 (fun str ->
+ bind "index" (untag_int arg2 dbg) (fun idx ->
+ Csequence(
+ make_checkbound dbg [string_length str dbg; idx],
+ Cop(Cstore (Byte_unsigned, Assignment),
+ [add_int str idx dbg;
+ ignore_high_bit_int (untag_int arg3 dbg)],
+ dbg)))))
+
+let arrayset_unsafe kind arg1 arg2 arg3 dbg =
+ return_unit dbg (match (kind: Lambda.array_kind) with
+ | Pgenarray ->
+ bind "newval" arg3 (fun newval ->
+ bind "index" arg2 (fun index ->
+ bind "arr" arg1 (fun arr ->
+ Cifthenelse(is_addr_array_ptr arr dbg,
+ dbg,
+ addr_array_set arr index newval dbg,
+ dbg,
+ float_array_set arr index (unbox_float dbg newval)
+ dbg,
+ dbg))))
+ | Paddrarray ->
+ addr_array_set arg1 arg2 arg3 dbg
+ | Pintarray ->
+ int_array_set arg1 arg2 arg3 dbg
+ | Pfloatarray ->
+ float_array_set arg1 arg2 arg3 dbg
+ )
+
+let arrayset_safe kind arg1 arg2 arg3 dbg =
+ return_unit dbg (match (kind: Lambda.array_kind) with
+ | Pgenarray ->
+ bind "newval" arg3 (fun newval ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
+ if wordsize_shift = numfloat_shift then
+ Csequence(
+ make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+ Cifthenelse(is_addr_array_hdr hdr dbg,
+ dbg,
+ addr_array_set arr idx newval dbg,
+ dbg,
+ float_array_set arr idx
+ (unbox_float dbg newval)
+ dbg,
+ dbg))
+ else
+ Cifthenelse(
+ is_addr_array_hdr hdr dbg,
+ dbg,
+ Csequence(
+ make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+ addr_array_set arr idx newval dbg),
+ dbg,
+ Csequence(
+ make_checkbound dbg [float_array_length_shifted hdr dbg; idx],
+ float_array_set arr idx
+ (unbox_float dbg newval) dbg),
+ dbg)))))
+ | Paddrarray ->
+ bind "newval" arg3 (fun newval ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ Csequence(
+ make_checkbound dbg [
+ addr_array_length_shifted
+ (get_header_without_profinfo arr dbg) dbg;
+ idx],
+ addr_array_set arr idx newval dbg))))
+ | Pintarray ->
+ bind "newval" arg3 (fun newval ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ Csequence(
+ make_checkbound dbg [
+ addr_array_length_shifted
+ (get_header_without_profinfo arr dbg) dbg;
+ idx],
+ int_array_set arr idx newval dbg))))
+ | Pfloatarray ->
+ bind_load "newval" arg3 (fun newval ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
+ Csequence(
+ make_checkbound dbg [
+ float_array_length_shifted
+ (get_header_without_profinfo arr dbg) dbg;
+ idx],
+ float_array_set arr idx newval dbg))))
+ )
+
+let bytes_set size unsafe arg1 arg2 arg3 dbg =
+ return_unit dbg
+ (bind "str" arg1 (fun str ->
+ bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "newval" arg3 (fun newval ->
+ check_bound unsafe size dbg (string_length str dbg)
+ idx (unaligned_set size str idx newval dbg)))))
+
+let bigstring_set size unsafe arg1 arg2 arg3 dbg =
+ return_unit dbg
+ (bind "ba" arg1 (fun ba ->
+ bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "newval" arg3 (fun newval ->
+ bind "ba_data"
+ (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
+ (fun ba_data ->
+ check_bound unsafe size dbg (bigstring_length ba dbg)
+ idx (unaligned_set size ba_data idx newval dbg))))))
+
+(* Symbols *)
+
+let cdefine_symbol (symb, (global: Cmmgen_state.is_global)) =
+ match global with
+ | Global -> [Cglobal_symbol symb; Cdefine_symbol symb]
+ | Local -> [Cdefine_symbol symb]
+
+let emit_block symb white_header cont =
+ (* Headers for structured constants must be marked black in case we
+ are in no-naked-pointers mode. See [caml_darken]. *)
+ let black_header = Nativeint.logor white_header caml_black in
+ Cint black_header :: cdefine_symbol symb @ cont
+
+let emit_string_constant_fields s cont =
+ let n = size_int - 1 - (String.length s) mod size_int in
+ Cstring s :: Cskip n :: Cint8 n :: cont
+
+let emit_boxed_int32_constant_fields n cont =
+ let n = Nativeint.of_int32 n in
+ if size_int = 8 then
+ Csymbol_address caml_int32_ops :: Cint32 n :: Cint32 0n :: cont
+ else
+ Csymbol_address caml_int32_ops :: Cint n :: cont
+
+let emit_boxed_int64_constant_fields n cont =
+ let lo = Int64.to_nativeint n in
+ if size_int = 8 then
+ Csymbol_address caml_int64_ops :: Cint lo :: cont
+ else begin
+ let hi = Int64.to_nativeint (Int64.shift_right n 32) in
+ if big_endian then
+ Csymbol_address caml_int64_ops :: Cint hi :: Cint lo :: cont
+ else
+ Csymbol_address caml_int64_ops :: Cint lo :: Cint hi :: cont
+ end
+
+let emit_boxed_nativeint_constant_fields n cont =
+ Csymbol_address caml_nativeint_ops :: Cint n :: cont
+
+let emit_float_constant symb f cont =
+ emit_block symb float_header (Cdouble f :: cont)
+
+let emit_string_constant symb s cont =
+ emit_block symb (string_header (String.length s))
+ (emit_string_constant_fields s cont)
+
+let emit_int32_constant symb n cont =
+ emit_block symb boxedint32_header
+ (emit_boxed_int32_constant_fields n cont)
+
+let emit_int64_constant symb n cont =
+ emit_block symb boxedint64_header
+ (emit_boxed_int64_constant_fields n cont)
+
+let emit_nativeint_constant symb n cont =
+ emit_block symb boxedintnat_header
+ (emit_boxed_nativeint_constant_fields n cont)
+
+let emit_float_array_constant symb fields cont =
+ emit_block symb (floatarray_header (List.length fields))
+ (Misc.map_end (fun f -> Cdouble f) fields cont)
+
+(* Generate the entry point *)
+
+let entry_point namelist =
+ let dbg = placeholder_dbg in
+ let cconst_int i = Cconst_int (i, dbg ()) in
+ let cconst_symbol sym = Cconst_symbol (sym, dbg ()) in
+ let incr_global_inited () =
+ Cop(Cstore (Word_int, Assignment),
+ [cconst_symbol "caml_globals_inited";
+ Cop(Caddi, [Cop(Cload (Word_int, Mutable),
+ [cconst_symbol "caml_globals_inited"], dbg ());
+ cconst_int 1], dbg ())], dbg ()) in
+ let body =
+ List.fold_right
+ (fun name next ->
+ let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in
+ Csequence(Cop(Capply typ_void,
+ [cconst_symbol entry_sym], dbg ()),
+ Csequence(incr_global_inited (), next)))
+ namelist (cconst_int 1) in
+ let fun_name = "caml_program" in
+ let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+ Cfunction {fun_name;
+ fun_args = [];
+ fun_body = body;
+ fun_codegen_options = [Reduce_code_size];
+ fun_dbg;
+ }
+
+(* Generate the table of globals *)
+
+let cint_zero = Cint 0n
+
+let global_table namelist =
+ let mksym name =
+ Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "gc_roots"))
+ in
+ Cdata(Cglobal_symbol "caml_globals" ::
+ Cdefine_symbol "caml_globals" ::
+ List.map mksym namelist @
+ [cint_zero])
+
+let reference_symbols namelist =
+ let mksym name = Csymbol_address name in
+ Cdata(List.map mksym namelist)
+
+let global_data name v =
+ Cdata(emit_string_constant (name, Global)
+ (Marshal.to_string v []) [])
+
+let globals_map v = global_data "caml_globals_map" v
+
+(* Generate the master table of frame descriptors *)
+
+let frame_table namelist =
+ let mksym name =
+ Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "frametable"))
+ in
+ Cdata(Cglobal_symbol "caml_frametable" ::
+ Cdefine_symbol "caml_frametable" ::
+ List.map mksym namelist
+ @ [cint_zero])
+
+(* Generate the master table of Spacetime shapes *)
+
+let spacetime_shapes namelist =
+ let mksym name =
+ Csymbol_address (
+ Compilenv.make_symbol ~unitname:name (Some "spacetime_shapes"))
+ in
+ Cdata(Cglobal_symbol "caml_spacetime_shapes" ::
+ Cdefine_symbol "caml_spacetime_shapes" ::
+ List.map mksym namelist
+ @ [cint_zero])
+
+(* Generate the table of module data and code segments *)
+
+let segment_table namelist symbol begname endname =
+ let addsyms name lst =
+ Csymbol_address (Compilenv.make_symbol ~unitname:name (Some begname)) ::
+ Csymbol_address (Compilenv.make_symbol ~unitname:name (Some endname)) ::
+ lst
+ in
+ Cdata(Cglobal_symbol symbol ::
+ Cdefine_symbol symbol ::
+ List.fold_right addsyms namelist [cint_zero])
+
+let data_segment_table namelist =
+ segment_table namelist "caml_data_segments" "data_begin" "data_end"
+
+let code_segment_table namelist =
+ segment_table namelist "caml_code_segments" "code_begin" "code_end"
+
+(* Initialize a predefined exception *)
+
+let predef_exception i name =
+ let name_sym = Compilenv.new_const_symbol () in
+ let data_items =
+ emit_string_constant (name_sym, Local) name []
+ in
+ let exn_sym = "caml_exn_" ^ name in
+ let tag = Obj.object_tag in
+ let size = 2 in
+ let fields =
+ (Csymbol_address name_sym)
+ :: (cint_const (-i - 1))
+ :: data_items
+ in
+ let data_items =
+ emit_block (exn_sym, Global) (block_header tag size) fields
+ in
+ Cdata data_items
+
+(* Header for a plugin *)
+
+let plugin_header units =
+ let mk ((ui : Cmx_format.unit_infos),crc) : Cmxs_format.dynunit =
+ { dynu_name = ui.ui_name;
+ dynu_crc = crc;
+ dynu_imports_cmi = ui.ui_imports_cmi;
+ dynu_imports_cmx = ui.ui_imports_cmx;
+ dynu_defines = ui.ui_defines
+ } in
+ global_data "caml_plugin_header"
+ ({ dynu_magic = Config.cmxs_magic_number;
+ dynu_units = List.map mk units }
+ : Cmxs_format.dynheader)
+
+(* To compile "let rec" over values *)
+
+let fundecls_size fundecls =
+ let sz = ref (-1) in
+ List.iter
+ (fun (f : Clambda.ufunction) ->
+ let indirect_call_code_pointer_size =
+ match f.arity with
+ | 0 | 1 -> 0
+ (* arity 1 does not need an indirect call handler.
+ arity 0 cannot be indirect called *)
+ | _ -> 1
+ (* For other arities there is an indirect call handler.
+ if arity >= 2 it is caml_curry...
+ if arity < 0 it is caml_tuplify... *)
+ in
+ sz := !sz + 1 + 2 + indirect_call_code_pointer_size)
+ fundecls;
+ !sz
+
+(* Emit constant closures *)
+
+let emit_constant_closure ((_, global_symb) as symb) fundecls clos_vars cont =
+ let closure_symbol (f : Clambda.ufunction) =
+ if Config.flambda then
+ cdefine_symbol (f.label ^ "_closure", global_symb)
+ else
+ []
+ in
+ match (fundecls : Clambda.ufunction list) with
+ [] ->
+ (* This should probably not happen: dead code has normally been
+ eliminated and a closure cannot be accessed without going through
+ a [Project_closure], which depends on the function. *)
+ assert (clos_vars = []);
+ cdefine_symbol symb @ clos_vars @ cont
+ | f1 :: remainder ->
+ let rec emit_others pos = function
+ [] -> clos_vars @ cont
+ | (f2 : Clambda.ufunction) :: rem ->
+ if f2.arity = 1 || f2.arity = 0 then
+ Cint(infix_header pos) ::
+ (closure_symbol f2) @
+ Csymbol_address f2.label ::
+ cint_const f2.arity ::
+ emit_others (pos + 3) rem
+ else
+ Cint(infix_header pos) ::
+ (closure_symbol f2) @
+ Csymbol_address(curry_function_sym f2.arity) ::
+ cint_const f2.arity ::
+ Csymbol_address f2.label ::
+ emit_others (pos + 4) rem in
+ Cint(black_closure_header (fundecls_size fundecls
+ + List.length clos_vars)) ::
+ cdefine_symbol symb @
+ (closure_symbol f1) @
+ if f1.arity = 1 || f1.arity = 0 then
+ Csymbol_address f1.label ::
+ cint_const f1.arity ::
+ emit_others 3 remainder
+ else
+ Csymbol_address(curry_function_sym f1.arity) ::
+ cint_const f1.arity ::
+ Csymbol_address f1.label ::
+ emit_others 4 remainder
+
+(* Build the NULL terminated array of gc roots *)
+
+let emit_gc_roots_table ~symbols cont =
+ let table_symbol = Compilenv.make_symbol (Some "gc_roots") in
+ Cdata(Cglobal_symbol table_symbol ::
+ Cdefine_symbol table_symbol ::
+ List.map (fun s -> Csymbol_address s) symbols @
+ [Cint 0n])
+ :: cont
+
+(* Build preallocated blocks (used for Flambda [Initialize_symbol]
+ constructs, and Clambda global module) *)
+
+let preallocate_block cont { Clambda.symbol; exported; tag; fields } =
+ let space =
+ (* These words will be registered as roots and as such must contain
+ valid values, in case we are in no-naked-pointers mode. Likewise
+ the block header must be black, below (see [caml_darken]), since
+ the overall record may be referenced. *)
+ List.map (fun field ->
+ match field with
+ | None ->
+ Cint (Nativeint.of_int 1 (* Val_unit *))
+ | Some (Clambda.Uconst_field_int n) ->
+ cint_const n
+ | Some (Clambda.Uconst_field_ref label) ->
+ Csymbol_address label)
+ fields
+ in
+ let global = Cmmgen_state.(if exported then Global else Local) in
+ let symb = (symbol, global) in
+ let data =
+ emit_block symb (block_header tag (List.length fields)) space
+ in
+ Cdata data :: cont
+
+let emit_preallocated_blocks preallocated_blocks cont =
+ let symbols =
+ List.map (fun ({ Clambda.symbol }:Clambda.preallocated_block) -> symbol)
+ preallocated_blocks
+ in
+ let c1 = emit_gc_roots_table ~symbols cont in
+ List.fold_left preallocate_block c1 preallocated_blocks
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Cmm
+
+(** [bind name arg fn] is equivalent to [let name = arg in fn name],
+ or simply [fn arg] if [arg] is simple enough *)
+val bind :
+ string -> expression -> (expression -> expression) -> expression
+
+(** Same as [bind], but also treats loads from a variable as simple *)
+val bind_load :
+ string -> expression -> (expression -> expression) -> expression
+
+(** Same as [bind], but does not treat variables as simple *)
+val bind_nonvar :
+ string -> expression -> (expression -> expression) -> expression
+
+(** Headers *)
+
+(** A null header with GC bits set to black *)
+val caml_black : nativeint
+
+(** A constant equal to the tag for float arrays *)
+val floatarray_tag : Debuginfo.t -> expression
+
+(** [block_header tag size] creates a header with tag [tag] for a
+ block of size [size] *)
+val block_header : int -> int -> nativeint
+
+(** Same as block_header, but with GC bits set to black *)
+val black_block_header : int -> int -> nativeint
+
+(** Closure headers of the given size *)
+val white_closure_header : int -> nativeint
+val black_closure_header : int -> nativeint
+
+(** Infix header at the given offset *)
+val infix_header : int -> nativeint
+
+(** Header for a boxed float value *)
+val float_header : nativeint
+
+(** Header for an unboxed float array of the given size *)
+val floatarray_header : int -> nativeint
+
+(** Header for a string (or bytes) of the given length *)
+val string_header : int -> nativeint
+
+(** Boxed integer headers *)
+val boxedint32_header : nativeint
+val boxedint64_header : nativeint
+val boxedintnat_header : nativeint
+
+(** Wrappers *)
+val alloc_float_header : Debuginfo.t -> expression
+val alloc_floatarray_header : int -> Debuginfo.t -> expression
+val alloc_closure_header : int -> Debuginfo.t -> expression
+val alloc_infix_header : int -> Debuginfo.t -> expression
+val alloc_boxedint32_header : Debuginfo.t -> expression
+val alloc_boxedint64_header : Debuginfo.t -> expression
+val alloc_boxedintnat_header : Debuginfo.t -> expression
+
+(** Integers *)
+
+(** Minimal/maximal OCaml integer values whose backend representation fits
+ in a regular OCaml integer *)
+val max_repr_int : int
+val min_repr_int : int
+
+(** Make an integer constant from the given integer (tags the integer) *)
+val int_const : Debuginfo.t -> int -> expression
+val cint_const : int -> data_item
+val targetint_const : int -> Targetint.t
+
+(** Make a Cmm constant holding the given nativeint value.
+ Uses [Cconst_int] instead of [Cconst_nativeint] when possible
+ to preserve peephole optimisations. *)
+val natint_const_untagged : Debuginfo.t -> Nativeint.t -> expression
+
+(** Add an integer to the given expression *)
+val add_const : expression -> int -> Debuginfo.t -> expression
+
+(** Increment/decrement of integers *)
+val incr_int : expression -> Debuginfo.t -> expression
+val decr_int : expression -> Debuginfo.t -> expression
+
+(** Simplify the given expression knowing its last bit will be
+ irrelevant *)
+val ignore_low_bit_int : expression -> expression
+
+(** Simplify the given expression knowing its first bit will be
+ irrelevant *)
+val ignore_high_bit_int : expression -> expression
+
+(** Arithmetical operations on integers *)
+val add_int : expression -> expression -> Debuginfo.t -> expression
+val sub_int : expression -> expression -> Debuginfo.t -> expression
+val lsl_int : expression -> expression -> Debuginfo.t -> expression
+val mul_int : expression -> expression -> Debuginfo.t -> expression
+val lsr_int : expression -> expression -> Debuginfo.t -> expression
+val asr_int : expression -> expression -> Debuginfo.t -> expression
+val div_int :
+ expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression
+val mod_int :
+ expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression
+
+(** Integer tagging. [tag_int x = (x lsl 1) + 1] *)
+val tag_int : expression -> Debuginfo.t -> expression
+
+(** Integer untagging. [untag_int x = (x asr 1)] *)
+val untag_int : expression -> Debuginfo.t -> expression
+
+(** Specific division operations for boxed integers *)
+val safe_div_bi :
+ Lambda.is_safe ->
+ expression ->
+ expression ->
+ Primitive.boxed_integer ->
+ Debuginfo.t ->
+ expression
+val safe_mod_bi :
+ Lambda.is_safe ->
+ expression ->
+ expression ->
+ Primitive.boxed_integer ->
+ Debuginfo.t ->
+ expression
+
+(** If-Then-Else expression
+ [mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot] associates
+ [dbg] to the global if-then-else expression, [ifso_dbg] to the
+ then branch [ifso], and [ifnot_dbg] to the else branch [ifnot] *)
+val mk_if_then_else :
+ Debuginfo.t ->
+ expression ->
+ Debuginfo.t -> expression ->
+ Debuginfo.t -> expression ->
+ expression
+
+(** Boolean negation *)
+val mk_not : Debuginfo.t -> expression -> expression
+
+(** Loop construction (while true do expr done).
+ Used to be represented as Cloop. *)
+val create_loop : expression -> Debuginfo.t -> expression
+
+(** Exception raising *)
+val raise_symbol : Debuginfo.t -> string -> expression
+
+(** Convert a tagged integer into a raw integer with boolean meaning *)
+val test_bool : Debuginfo.t -> expression -> expression
+
+(** Float boxing and unboxing *)
+val box_float : Debuginfo.t -> expression -> expression
+val unbox_float : Debuginfo.t -> expression -> expression
+
+(** Complex number creation and access *)
+val box_complex : Debuginfo.t -> expression -> expression -> expression
+val complex_re : expression -> Debuginfo.t -> expression
+val complex_im : expression -> Debuginfo.t -> expression
+
+(** Make the given expression return a unit value *)
+val return_unit : Debuginfo.t -> expression -> expression
+
+(** Remove a trailing unit return if any *)
+val remove_unit : expression -> expression
+
+(** Blocks *)
+
+(** [field_address ptr n dbg] returns an expression for the address of the
+ [n]th field of the block pointed to by [ptr] *)
+val field_address : expression -> int -> Debuginfo.t -> expression
+
+(** [get_field_gen mut ptr n dbg] returns an expression for the access to the
+ [n]th field of the block pointed to by [ptr] *)
+val get_field_gen :
+ Asttypes.mutable_flag -> expression -> int -> Debuginfo.t -> expression
+
+(** [set_field ptr n newval init dbg] returns an expression for setting the
+ [n]th field of the block pointed to by [ptr] to [newval] *)
+val set_field :
+ expression -> int -> expression -> Lambda.initialization_or_assignment ->
+ Debuginfo.t -> expression
+
+(** Load a block's header *)
+val get_header : expression -> Debuginfo.t -> expression
+
+(** Same as [get_header], but also set all profiling bits of the header
+ are to 0 (if profiling is enabled) *)
+val get_header_without_profinfo : expression -> Debuginfo.t -> expression
+
+(** Load a block's tag *)
+val get_tag : expression -> Debuginfo.t -> expression
+
+(** Load a block's size *)
+val get_size : expression -> Debuginfo.t -> expression
+
+(** Arrays *)
+
+val wordsize_shift : int
+val numfloat_shift : int
+
+(** Check whether the given array is an array of regular OCaml values
+ (as opposed to unboxed floats), from its header or pointer *)
+val is_addr_array_hdr : expression -> Debuginfo.t -> expression
+val is_addr_array_ptr : expression -> Debuginfo.t -> expression
+
+(** Get the length of an array from its header
+ Shifts by one bit less than necessary, keeping one of the GC colour bits,
+ to save an operation when returning the length as a caml integer or when
+ comparing it to a caml integer.
+ Assumes the header does not have any profiling info
+ (as returned by get_header_without_profinfo) *)
+val addr_array_length_shifted : expression -> Debuginfo.t -> expression
+val float_array_length_shifted : expression -> Debuginfo.t -> expression
+
+(** For [array_indexing ?typ log2size ptr ofs dbg] :
+ Produces a pointer to the element of the array [ptr] on the position [ofs]
+ with the given element [log2size] log2 element size. [ofs] is given as a
+ tagged int expression.
+ The optional ?typ argument is the C-- type of the result.
+ By default, it is Addr, meaning we are constructing a derived pointer
+ into the heap. If we know the pointer is outside the heap
+ (this is the case for bigarray indexing), we give type Int instead. *)
+val array_indexing :
+ ?typ:machtype_component -> int -> expression -> expression -> Debuginfo.t ->
+ expression
+
+(** Array loads and stores
+ [unboxed_float_array_ref] and [float_array_ref] differ in the
+ boxing of the result; [float_array_set] takes an unboxed float *)
+val addr_array_ref : expression -> expression -> Debuginfo.t -> expression
+val int_array_ref : expression -> expression -> Debuginfo.t -> expression
+val unboxed_float_array_ref :
+ expression -> expression -> Debuginfo.t -> expression
+val float_array_ref : expression -> expression -> Debuginfo.t -> expression
+val addr_array_set :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+val addr_array_initialize :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+val int_array_set :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+val float_array_set :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** Strings *)
+
+val string_length : expression -> Debuginfo.t -> expression
+val bigstring_length : expression -> Debuginfo.t -> expression
+
+(** Objects *)
+
+(** Lookup a method by its hash, using [caml_get_public_method]
+ Arguments :
+ - obj : the object from which to lookup
+ - tag : the hash of the method name, as a tagged integer *)
+val lookup_tag : expression -> expression -> Debuginfo.t -> expression
+
+(** Lookup a method by its offset in the method table
+ Arguments :
+ - obj : the object from which to lookup
+ - lab : the position of the required method in the object's
+ method array, as a tagged integer *)
+val lookup_label : expression -> expression -> Debuginfo.t -> expression
+
+(** Lookup and call a method using the method cache
+ Arguments :
+ - obj : the object from which to lookup
+ - tag : the hash of the method name, as a tagged integer
+ - cache : the method cache array
+ - pos : the position of the cache entry in the cache array
+ - args : the additional arguments to the method call *)
+val call_cached_method :
+ expression -> expression -> expression -> expression -> expression list ->
+ Debuginfo.t -> expression
+
+(** Allocations *)
+
+(** Allocate a block of regular values with the given tag *)
+val make_alloc : Debuginfo.t -> int -> expression list -> expression
+
+(** Allocate a block of unboxed floats with the given tag *)
+val make_float_alloc : Debuginfo.t -> int -> expression list -> expression
+
+(** Bounds checking *)
+
+(** Generate a [Ccheckbound] term *)
+val make_checkbound : Debuginfo.t -> expression list -> expression
+
+(** [check_bound safety access_size dbg length a2 k] prefixes expression [k]
+ with a check that reading [access_size] bits starting at position [a2]
+ in a string/bytes value of length [length] is within bounds, unless
+ [safety] is [Unsafe]. *)
+val check_bound :
+ Lambda.is_safe -> Clambda_primitives.memory_access_size -> Debuginfo.t ->
+ expression -> expression -> expression ->
+ expression
+
+(** Generic application functions *)
+
+(** Get the symbol for the generic application with [n] arguments, and
+ ensure its presence in the set of defined symbols *)
+val apply_function_sym : int -> string
+
+(** If [n] is positive, get the symbol for the generic currying wrapper with
+ [n] arguments, and ensure its presence in the set of defined symbols.
+ Otherwise, do the same for the generic tuple wrapper with [-n] arguments. *)
+val curry_function_sym : int -> string
+
+(** Bigarrays *)
+
+(** [bigarray_get unsafe kind layout b args dbg]
+ - unsafe : if true, do not insert bound checks
+ - kind : see [Lambda.bigarray_kind]
+ - layout : see [Lambda.bigarray_layout]
+ - b : the bigarray to load from
+ - args : a list of tagged integer expressions, corresponding to the
+ indices in the respective dimensions
+ - dbg : debugging information *)
+val bigarray_get :
+ bool -> Lambda.bigarray_kind -> Lambda.bigarray_layout ->
+ expression -> expression list -> Debuginfo.t ->
+ expression
+
+(** [bigarray_set unsafe kind layout b args newval dbg]
+ Same as [bigarray_get], with [newval] the value being assigned *)
+val bigarray_set :
+ bool -> Lambda.bigarray_kind -> Lambda.bigarray_layout ->
+ expression -> expression list -> expression -> Debuginfo.t ->
+ expression
+
+(** Operations on 32-bit integers *)
+
+(** [low_32 _ x] is a value which agrees with x on at least the low 32 bits *)
+val low_32 : Debuginfo.t -> expression -> expression
+
+(** Sign extend from 32 bits to the word size *)
+val sign_extend_32 : Debuginfo.t -> expression -> expression
+
+(** Zero extend from 32 bits to the word size *)
+val zero_extend_32 : Debuginfo.t -> expression -> expression
+
+(** Boxed numbers *)
+
+(** Global symbols for the ops field of boxed integers *)
+val caml_nativeint_ops : string
+val caml_int32_ops : string
+val caml_int64_ops : string
+
+(** Box a given integer, without sharing of constants *)
+val box_int_gen :
+ Debuginfo.t -> Primitive.boxed_integer -> expression -> expression
+
+(** Unbox a given boxed integer *)
+val unbox_int :
+ Debuginfo.t -> Primitive.boxed_integer -> expression -> expression
+
+(** Used to prepare 32-bit integers on 64-bit platforms for a lsr operation *)
+val make_unsigned_int :
+ Primitive.boxed_integer -> expression -> Debuginfo.t -> expression
+
+val unaligned_load_16 : expression -> expression -> Debuginfo.t -> expression
+val unaligned_set_16 :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+val unaligned_load_32 : expression -> expression -> Debuginfo.t -> expression
+val unaligned_set_32 :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+val unaligned_load_64 : expression -> expression -> Debuginfo.t -> expression
+val unaligned_set_64 :
+ expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** Raw memory accesses *)
+
+(** [unaligned_set size ptr idx newval dbg] *)
+val unaligned_set :
+ Clambda_primitives.memory_access_size ->
+ expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** [unaligned_load size ptr idx dbg] *)
+val unaligned_load :
+ Clambda_primitives.memory_access_size ->
+ expression -> expression -> Debuginfo.t -> expression
+
+(** [box_sized size dbg exp] *)
+val box_sized :
+ Clambda_primitives.memory_access_size ->
+ Debuginfo.t -> expression -> expression
+
+(** Primitives *)
+
+val simplif_primitive :
+ Clambda_primitives.primitive -> Clambda_primitives.primitive
+
+type unary_primitive = expression -> Debuginfo.t -> expression
+
+(** Return the n-th field of a float array (or float-only record), as an
+ unboxed float *)
+val floatfield : int -> unary_primitive
+
+(** Int_as_pointer primitive *)
+val int_as_pointer : unary_primitive
+
+(** Raise primitive *)
+val raise_prim : Lambda.raise_kind -> unary_primitive
+
+(** Unary negation of an OCaml integer *)
+val negint : unary_primitive
+
+(** Add a constant number to an OCaml integer *)
+val offsetint : int -> unary_primitive
+
+(** Add a constant number to an OCaml integer reference *)
+val offsetref : int -> unary_primitive
+
+(** Return the length of the array argument, as an OCaml integer *)
+val arraylength : Lambda.array_kind -> unary_primitive
+
+(** Byte swap primitive
+ Operates on Cmm integers (unboxed values) *)
+val bbswap : Primitive.boxed_integer -> unary_primitive
+
+(** 16-bit byte swap primitive
+ Operates on Cmm integers (untagged integers) *)
+val bswap16 : unary_primitive
+
+type binary_primitive = expression -> expression -> Debuginfo.t -> expression
+
+type assignment_kind = Caml_modify | Caml_initialize | Simple
+
+(** [setfield offset value_is_ptr init ptr value dbg] *)
+val setfield :
+ int -> Lambda.immediate_or_pointer -> Lambda.initialization_or_assignment ->
+ binary_primitive
+
+(** [setfloatfield offset init ptr value dbg]
+ [value] is expected to be an unboxed floating point number *)
+val setfloatfield :
+ int -> Lambda.initialization_or_assignment -> binary_primitive
+
+(** Operations on OCaml integers *)
+val add_int_caml : binary_primitive
+val sub_int_caml : binary_primitive
+val mul_int_caml : binary_primitive
+val div_int_caml : Lambda.is_safe -> binary_primitive
+val mod_int_caml : Lambda.is_safe -> binary_primitive
+val and_int_caml : binary_primitive
+val or_int_caml : binary_primitive
+val xor_int_caml : binary_primitive
+val lsl_int_caml : binary_primitive
+val lsr_int_caml : binary_primitive
+val asr_int_caml : binary_primitive
+val int_comp_caml : Lambda.integer_comparison -> binary_primitive
+
+(** Strings, Bytes and Bigstrings *)
+
+(** Regular string/bytes access. Args: string/bytes, index *)
+val stringref_unsafe : binary_primitive
+val stringref_safe : binary_primitive
+
+(** Load by chunk from string/bytes, bigstring. Args: string, index *)
+val string_load :
+ Clambda_primitives.memory_access_size -> Lambda.is_safe -> binary_primitive
+val bigstring_load :
+ Clambda_primitives.memory_access_size -> Lambda.is_safe -> binary_primitive
+
+(** Arrays *)
+
+(** Array access. Args: array, index *)
+val arrayref_unsafe : Lambda.array_kind -> binary_primitive
+val arrayref_safe : Lambda.array_kind -> binary_primitive
+
+type ternary_primitive =
+ expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** Same as setfield, except the offset is one of the arguments.
+ Args: pointer (structure/array/...), index, value *)
+val setfield_computed :
+ Lambda.immediate_or_pointer -> Lambda.initialization_or_assignment ->
+ ternary_primitive
+
+(** Set the byte at the given offset to the given value.
+ Args: bytes, index, value *)
+val bytesset_unsafe : ternary_primitive
+val bytesset_safe : ternary_primitive
+
+(** Set the element at the given index in the given array to the given value.
+ WARNING: if [kind] is [Pfloatarray], then [value] is expected to be an
+ _unboxed_ float. Otherwise, it is expected to be a regular caml value,
+ including in the case where the array contains floats.
+ Args: array, index, value *)
+val arrayset_unsafe : Lambda.array_kind -> ternary_primitive
+val arrayset_safe : Lambda.array_kind -> ternary_primitive
+
+(** Set a chunk of data in the given bytes or bigstring structure.
+ See also [string_load] and [bigstring_load].
+ Note: [value] is expected to be an unboxed number of the given size.
+ Args: pointer, index, value *)
+val bytes_set :
+ Clambda_primitives.memory_access_size -> Lambda.is_safe -> ternary_primitive
+val bigstring_set :
+ Clambda_primitives.memory_access_size -> Lambda.is_safe -> ternary_primitive
+
+(** Switch *)
+
+(** [transl_isout h arg dbg] *)
+val transl_isout : expression -> expression -> Debuginfo.t -> expression
+
+(** [make_switch arg cases actions dbg] : Generate a Cswitch construct,
+ or optimize as a static table lookup when possible. *)
+val make_switch :
+ expression -> int array -> (expression * Debuginfo.t) array -> Debuginfo.t ->
+ expression
+
+(** [transl_int_switch loc arg low high cases default] *)
+val transl_int_switch :
+ Location.t -> expression -> int -> int ->
+ (int * expression) list -> expression -> expression
+
+(** [transl_switch_clambda loc arg index cases] *)
+val transl_switch_clambda :
+ Location.t -> expression -> int array -> expression array -> expression
+
+(** [strmatch_compile dbg arg default cases] *)
+val strmatch_compile :
+ Debuginfo.t -> expression -> expression option ->
+ (string * expression) list -> expression
+
+(** Closures and function applications *)
+
+(** Adds a constant offset to a pointer (for infix access) *)
+val ptr_offset : expression -> int -> Debuginfo.t -> expression
+
+(** Direct application of a function via a symbol *)
+val direct_apply : string -> expression list -> Debuginfo.t -> expression
+
+(** Generic application of a function to one or several arguments.
+ The mutable_flag argument annotates the loading of the code pointer
+ from the closure. The Cmmgen code uses a mutable load by
+ default, with a special case when the load is from (the first function of)
+ the currently defined closure. *)
+val generic_apply :
+ Asttypes.mutable_flag ->
+ expression -> expression list -> Debuginfo.t -> expression
+
+(** Method call : [send kind met obj args dbg]
+ - [met] is a method identifier, which can be a hashed variant or an index
+ in [obj]'s method table, depending on [kind]
+ - [obj] is the object whose method is being called
+ - [args] is the extra arguments to the method call (Note: I'm not aware
+ of any way for the frontend to generate any arguments other than the
+ cache and cache position) *)
+val send :
+ Lambda.meth_kind -> expression -> expression -> expression list ->
+ Debuginfo.t -> expression
+
+(** Generic Cmm fragments *)
+
+(** Generate generic functions *)
+val generic_functions : bool -> Cmx_format.unit_infos list -> Cmm.phrase list
+
+val placeholder_dbg : unit -> Debuginfo.t
+val placeholder_fun_dbg : human_name:string -> Debuginfo.t
+
+(** Entry point *)
+val entry_point : string list -> phrase
+
+(** Generate the caml_globals table *)
+val global_table: string list -> phrase
+
+(** Add references to the given symbols *)
+val reference_symbols: string list -> phrase
+
+(** Generate the caml_globals_map structure, as a marshalled string constant *)
+val globals_map:
+ (string * Digest.t option * Digest.t option * string list) list -> phrase
+
+(** Generate the caml_frametable table, referencing the frametables
+ from the given compilation units *)
+val frame_table: string list -> phrase
+
+(** Generate the caml_spacetime_shapes table, referencing the spacetime shapes
+ from the given compilation units *)
+val spacetime_shapes: string list -> phrase
+
+(** Generate the tables for data and code positions respectively of the given
+ compilation units *)
+val data_segment_table: string list -> phrase
+val code_segment_table: string list -> phrase
+
+(** Generate data for a predefined exception *)
+val predef_exception: int -> string -> phrase
+
+val plugin_header: (Cmx_format.unit_infos * Digest.t) list -> phrase
+
+(** Emit constant symbols *)
+
+(** Produce the data_item list corresponding to a symbol definition *)
+val cdefine_symbol : (string * Cmmgen_state.is_global) -> data_item list
+
+(** [emit_block symb white_header cont] prepends to [cont] the header and symbol
+ for the block.
+ [cont] must already contain the fields of the block (and may contain
+ additional data items afterwards). *)
+val emit_block :
+ (string * Cmmgen_state.is_global) -> nativeint -> data_item list ->
+ data_item list
+
+(** Emit specific kinds of constant blocks as data items *)
+val emit_float_constant :
+ (string * Cmmgen_state.is_global) -> float -> data_item list ->
+ data_item list
+val emit_string_constant :
+ (string * Cmmgen_state.is_global) -> string -> data_item list ->
+ data_item list
+val emit_int32_constant :
+ (string * Cmmgen_state.is_global) -> int32 -> data_item list ->
+ data_item list
+val emit_int64_constant :
+ (string * Cmmgen_state.is_global) -> int64 -> data_item list ->
+ data_item list
+val emit_nativeint_constant :
+ (string * Cmmgen_state.is_global) -> nativeint -> data_item list ->
+ data_item list
+val emit_float_array_constant :
+ (string * Cmmgen_state.is_global) -> float list -> data_item list ->
+ data_item list
+
+val fundecls_size : Clambda.ufunction list -> int
+
+val emit_constant_closure :
+ (string * Cmmgen_state.is_global) -> Clambda.ufunction list ->
+ data_item list -> data_item list -> data_item list
+
+val emit_preallocated_blocks :
+ Clambda.preallocated_block list -> phrase list -> phrase list
open Clambda
open Clambda_primitives
open Cmm
-open Cmx_format
-open Cmxs_format
module String = Misc.Stdlib.String
+module IntMap = Map.Make(Int)
module V = Backend_var
module VP = Backend_var.With_provenance
+open Cmm_helpers
(* Environments used for translation to Cmm. *)
type env = {
unboxed_ids : (V.t * boxed_number) V.tbl;
+ notify_catch : (Cmm.expression list -> unit) IntMap.t;
environment_param : V.t option;
}
+(* notify_catch associates to each catch handler a callback
+ which will be passed the list of arguments of each
+ staticfail instruction pointing to that handler. This
+ allows transl_catch to observe concrete arguments passed to each
+ handler parameter and decide whether to unbox them accordingly.
+
+ Other ways to achieve the same result would be to either (1) traverse
+ the body of the catch block after translation (this would be costly
+ and could easily lead to quadratric behavior) or (2) return
+ a description of arguments passed to each catch handler as an extra
+ value to be threaded through all transl_* functions (this would be
+ quite heavy, and probably less efficient that the callback approach).
+*)
+
+
let empty_env =
{
- unboxed_ids =V.empty;
+ unboxed_ids = V.empty;
+ notify_catch = IntMap.empty;
environment_param = None;
}
let create_env ~environment_param =
- { unboxed_ids = V.empty;
+ { empty_env with
environment_param;
}
unboxed_ids = V.add id (unboxed_id, bn) env.unboxed_ids;
}
-(* Local binding of complex expressions *)
-
-let bind name arg fn =
- match arg with
- Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
- | Cconst_pointer _ | Cconst_natpointer _
- | Cblockheader _ -> fn arg
- | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
-
-let bind_load name arg fn =
- match arg with
- | Cop(Cload _, [Cvar _], _) -> fn arg
- | _ -> bind name arg fn
-
-let bind_nonvar name arg fn =
- match arg with
- Cconst_int _ | Cconst_natint _ | Cconst_symbol _
- | Cconst_pointer _ | Cconst_natpointer _
- | Cblockheader _ -> fn arg
- | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
-
-let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
- (* cf. runtime/caml/gc.h *)
-
-(* Block headers. Meaning of the tag field: see stdlib/obj.ml *)
-
-let floatarray_tag dbg = Cconst_int (Obj.double_array_tag, dbg)
-
-let block_header tag sz =
- Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10)
- (Nativeint.of_int tag)
-(* Static data corresponding to "value"s must be marked black in case we are
- in no-naked-pointers mode. See [caml_darken] and the code below that emits
- structured constants and static module definitions. *)
-let black_block_header tag sz = Nativeint.logor (block_header tag sz) caml_black
-let white_closure_header sz = block_header Obj.closure_tag sz
-let black_closure_header sz = black_block_header Obj.closure_tag sz
-let infix_header ofs = block_header Obj.infix_tag ofs
-let float_header = block_header Obj.double_tag (size_float / size_addr)
-let floatarray_header len =
- (* Zero-sized float arrays have tag zero for consistency with
- [caml_alloc_float_array]. *)
- assert (len >= 0);
- if len = 0 then block_header 0 0
- else block_header Obj.double_array_tag (len * size_float / size_addr)
-let string_header len =
- block_header Obj.string_tag ((len + size_addr) / size_addr)
-let boxedint32_header = block_header Obj.custom_tag 2
-let boxedint64_header = block_header Obj.custom_tag (1 + 8 / size_addr)
-let boxedintnat_header = block_header Obj.custom_tag 2
-let caml_nativeint_ops = "caml_nativeint_ops"
-let caml_int32_ops = "caml_int32_ops"
-let caml_int64_ops = "caml_int64_ops"
-
-
-let alloc_float_header dbg = Cblockheader (float_header, dbg)
-let alloc_floatarray_header len dbg = Cblockheader (floatarray_header len, dbg)
-let alloc_closure_header sz dbg = Cblockheader (white_closure_header sz, dbg)
-let alloc_infix_header ofs dbg = Cblockheader (infix_header ofs, dbg)
-let alloc_boxedint32_header dbg = Cblockheader (boxedint32_header, dbg)
-let alloc_boxedint64_header dbg = Cblockheader (boxedint64_header, dbg)
-let alloc_boxedintnat_header dbg = Cblockheader (boxedintnat_header, dbg)
-
-(* Integers *)
-
-let max_repr_int = max_int asr 1
-let min_repr_int = min_int asr 1
-
-let int_const dbg n =
- if n <= max_repr_int && n >= min_repr_int
- then Cconst_int((n lsl 1) + 1, dbg)
- else Cconst_natint
- (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n, dbg)
-
-let natint_const_untagged dbg n =
- if n > Nativeint.of_int max_int
- || n < Nativeint.of_int min_int
- then Cconst_natint (n,dbg)
- else Cconst_int (Nativeint.to_int n, dbg)
-
-let cint_const n =
- Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n)
-
-let targetint_const n =
- Targetint.add (Targetint.shift_left (Targetint.of_int n) 1)
- Targetint.one
-
-let add_no_overflow n x c dbg =
- let d = n + x in
- if d = 0 then c else Cop(Caddi, [c; Cconst_int (d, dbg)], dbg)
-
-let rec add_const c n dbg =
- if n = 0 then c
- else match c with
- | Cconst_int (x, _) when no_overflow_add x n -> Cconst_int (x + n, dbg)
- | Cop(Caddi, [Cconst_int (x, _); c], _)
- when no_overflow_add n x ->
- add_no_overflow n x c dbg
- | Cop(Caddi, [c; Cconst_int (x, _)], _)
- when no_overflow_add n x ->
- add_no_overflow n x c dbg
- | Cop(Csubi, [Cconst_int (x, _); c], _) when no_overflow_add n x ->
- Cop(Csubi, [Cconst_int (n + x, dbg); c], dbg)
- | Cop(Csubi, [c; Cconst_int (x, _)], _) when no_overflow_sub n x ->
- add_const c (n - x) dbg
- | c -> Cop(Caddi, [c; Cconst_int (n, dbg)], dbg)
-
-let incr_int c dbg = add_const c 1 dbg
-let decr_int c dbg = add_const c (-1) dbg
-
-let rec add_int c1 c2 dbg =
- match (c1, c2) with
- | (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) ->
- add_const c n dbg
- | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) ->
- add_const (add_int c1 c2 dbg) n1 dbg
- | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) ->
- add_const (add_int c1 c2 dbg) n2 dbg
- | (_, _) ->
- Cop(Caddi, [c1; c2], dbg)
-
-let rec sub_int c1 c2 dbg =
- match (c1, c2) with
- | (c1, Cconst_int (n2, _)) when n2 <> min_int ->
- add_const c1 (-n2) dbg
- | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) when n2 <> min_int ->
- add_const (sub_int c1 c2 dbg) (-n2) dbg
- | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) ->
- add_const (sub_int c1 c2 dbg) n1 dbg
- | (c1, c2) ->
- Cop(Csubi, [c1; c2], dbg)
-
-let rec lsl_int c1 c2 dbg =
- match (c1, c2) with
- | (Cop(Clsl, [c; Cconst_int (n1, _)], _), Cconst_int (n2, _))
- when n1 > 0 && n2 > 0 && n1 + n2 < size_int * 8 ->
- Cop(Clsl, [c; Cconst_int (n1 + n2, dbg)], dbg)
- | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), Cconst_int (n2, _))
- when no_overflow_lsl n1 n2 ->
- add_const (lsl_int c1 c2 dbg) (n1 lsl n2) dbg
- | (_, _) ->
- Cop(Clsl, [c1; c2], dbg)
-
-let is_power2 n = n = 1 lsl Misc.log2 n
-
-and mult_power2 c n dbg = lsl_int c (Cconst_int (Misc.log2 n, dbg)) dbg
-
-let rec mul_int c1 c2 dbg =
- match (c1, c2) with
- | (c, Cconst_int (0, _)) | (Cconst_int (0, _), c) ->
- Csequence (c, Cconst_int (0, dbg))
- | (c, Cconst_int (1, _)) | (Cconst_int (1, _), c) ->
- c
- | (c, Cconst_int(-1, _)) | (Cconst_int(-1, _), c) ->
- sub_int (Cconst_int (0, dbg)) c dbg
- | (c, Cconst_int (n, _)) when is_power2 n -> mult_power2 c n dbg
- | (Cconst_int (n, _), c) when is_power2 n -> mult_power2 c n dbg
- | (Cop(Caddi, [c; Cconst_int (n, _)], _), Cconst_int (k, _)) |
- (Cconst_int (k, _), Cop(Caddi, [c; Cconst_int (n, _)], _))
- when no_overflow_mul n k ->
- add_const (mul_int c (Cconst_int (k, dbg)) dbg) (n * k) dbg
- | (c1, c2) ->
- Cop(Cmuli, [c1; c2], dbg)
-
-
-let ignore_low_bit_int = function
- Cop(Caddi,
- [(Cop(Clsl, [_; Cconst_int (n, _)], _) as c); Cconst_int (1, _)], _)
- when n > 0
- -> c
- | Cop(Cor, [c; Cconst_int (1, _)], _) -> c
- | c -> c
-
-let lsr_int c1 c2 dbg =
- match c2 with
- Cconst_int (0, _) ->
- c1
- | Cconst_int (n, _) when n > 0 ->
- Cop(Clsr, [ignore_low_bit_int c1; c2], dbg)
- | _ ->
- Cop(Clsr, [c1; c2], dbg)
-
-let asr_int c1 c2 dbg =
- match c2 with
- Cconst_int (0, _) ->
- c1
- | Cconst_int (n, _) when n > 0 ->
- Cop(Casr, [ignore_low_bit_int c1; c2], dbg)
- | _ ->
- Cop(Casr, [c1; c2], dbg)
+let add_notify_catch n f env =
+ { env with
+ notify_catch = IntMap.add n f env.notify_catch
+ }
-let tag_int i dbg =
- match i with
- | Cconst_int (n, _) ->
- int_const dbg n
- | Cop(Casr, [c; Cconst_int (n, _)], _) when n > 0 ->
- Cop(Cor,
- [asr_int c (Cconst_int (n - 1, dbg)) dbg; Cconst_int (1, dbg)],
- dbg)
- | c ->
- incr_int (lsl_int c (Cconst_int (1, dbg)) dbg) dbg
-
-let force_tag_int i dbg =
- match i with
- Cconst_int (n, _) ->
- int_const dbg n
- | Cop(Casr, [c; Cconst_int (n, _)], dbg') when n > 0 ->
- Cop(Cor, [asr_int c (Cconst_int (n - 1, dbg)) dbg'; Cconst_int (1, dbg)],
- dbg)
- | c ->
- Cop(Cor, [lsl_int c (Cconst_int (1, dbg)) dbg; Cconst_int (1, dbg)], dbg)
-
-let untag_int i dbg =
- match i with
- Cconst_int (n, _) -> Cconst_int(n asr 1, dbg)
- | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) ->
- c
- | Cop(Cor, [Cop(Casr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _)
- when n > 0 && n < size_int * 8 ->
- Cop(Casr, [c; Cconst_int (n+1, dbg)], dbg)
- | Cop(Cor, [Cop(Clsr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _)
- when n > 0 && n < size_int * 8 ->
- Cop(Clsr, [c; Cconst_int (n+1, dbg)], dbg)
- | Cop(Cor, [c; Cconst_int (1, _)], _) ->
- Cop(Casr, [c; Cconst_int (1, dbg)], dbg)
- | c -> Cop(Casr, [c; Cconst_int (1, dbg)], dbg)
+let notify_catch i env l =
+ match IntMap.find_opt i env.notify_catch with
+ | Some f -> f l
+ | None -> ()
(* Description of the "then" and "else" continuations in [transl_if]. If
the "then" continuation is true and the "else" continuation is false then
| Then_false_else_true -> Then_true_else_false
| Unknown -> Unknown
-let mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot =
- match cond with
- | Cconst_int (0, _) -> ifnot
- | Cconst_int (1, _) -> ifso
- | _ ->
- Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg)
-
-let mk_not dbg cmm =
- match cmm with
- | Cop(Caddi,
- [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') ->
- begin
- match c with
- | Cop(Ccmpi cmp, [c1; c2], dbg'') ->
- tag_int
- (Cop(Ccmpi (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg'
- | Cop(Ccmpa cmp, [c1; c2], dbg'') ->
- tag_int
- (Cop(Ccmpa (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg'
- | Cop(Ccmpf cmp, [c1; c2], dbg'') ->
- tag_int
- (Cop(Ccmpf (negate_float_comparison cmp), [c1; c2], dbg'')) dbg'
- | _ ->
- (* 0 -> 3, 1 -> 1 *)
- Cop(Csubi,
- [Cconst_int (3, dbg); Cop(Clsl, [c; Cconst_int (1, dbg)], dbg)], dbg)
- end
- | Cconst_int (3, _) -> Cconst_int (1, dbg)
- | Cconst_int (1, _) -> Cconst_int (3, dbg)
- | c ->
- (* 1 -> 3, 3 -> 1 *)
- Cop(Csubi, [Cconst_int (4, dbg); c], dbg)
-
-
-let create_loop body dbg =
- let cont = next_raise_count () in
- let call_cont = Cexit (cont, []) in
- let body = Csequence (body, call_cont) in
- Ccatch (Recursive, [cont, [], body, dbg], call_cont)
-
-(* Turning integer divisions into multiply-high then shift.
- The [division_parameters] function is used in module Emit for
- those target platforms that support this optimization. *)
-
-(* Unsigned comparison between native integers. *)
-
-let ucompare x y = Nativeint.(compare (add x min_int) (add y min_int))
-
-(* Unsigned division and modulus at type nativeint.
- Algorithm: Hacker's Delight section 9.3 *)
-
-let udivmod n d = Nativeint.(
- if d < 0n then
- if ucompare n d < 0 then (0n, n) else (1n, sub n d)
- else begin
- let q = shift_left (div (shift_right_logical n 1) d) 1 in
- let r = sub n (mul q d) in
- if ucompare r d >= 0 then (succ q, sub r d) else (q, r)
- end)
-
-(* Compute division parameters.
- Algorithm: Hacker's Delight chapter 10, fig 10-1. *)
-
-let divimm_parameters d = Nativeint.(
- assert (d > 0n);
- let twopsm1 = min_int in (* 2^31 for 32-bit archs, 2^63 for 64-bit archs *)
- let nc = sub (pred twopsm1) (snd (udivmod twopsm1 d)) in
- let rec loop p (q1, r1) (q2, r2) =
- let p = p + 1 in
- let q1 = shift_left q1 1 and r1 = shift_left r1 1 in
- let (q1, r1) =
- if ucompare r1 nc >= 0 then (succ q1, sub r1 nc) else (q1, r1) in
- let q2 = shift_left q2 1 and r2 = shift_left r2 1 in
- let (q2, r2) =
- if ucompare r2 d >= 0 then (succ q2, sub r2 d) else (q2, r2) in
- let delta = sub d r2 in
- if ucompare q1 delta < 0 || (q1 = delta && r1 = 0n)
- then loop p (q1, r1) (q2, r2)
- else (succ q2, p - size)
- in loop (size - 1) (udivmod twopsm1 nc) (udivmod twopsm1 d))
-
-(* The result [(m, p)] of [divimm_parameters d] satisfies the following
- inequality:
-
- 2^(wordsize + p) < m * d <= 2^(wordsize + p) + 2^(p + 1) (i)
-
- from which it follows that
-
- floor(n / d) = floor(n * m / 2^(wordsize+p))
- if 0 <= n < 2^(wordsize-1)
- ceil(n / d) = floor(n * m / 2^(wordsize+p)) + 1
- if -2^(wordsize-1) <= n < 0
-
- The correctness condition (i) above can be checked by the code below.
- It was exhaustively tested for values of d from 2 to 10^9 in the
- wordsize = 64 case.
-
-let add2 (xh, xl) (yh, yl) =
- let zl = add xl yl and zh = add xh yh in
- ((if ucompare zl xl < 0 then succ zh else zh), zl)
-
-let shl2 (xh, xl) n =
- assert (0 < n && n < size + size);
- if n < size
- then (logor (shift_left xh n) (shift_right_logical xl (size - n)),
- shift_left xl n)
- else (shift_left xl (n - size), 0n)
-
-let mul2 x y =
- let halfsize = size / 2 in
- let halfmask = pred (shift_left 1n halfsize) in
- let xl = logand x halfmask and xh = shift_right_logical x halfsize in
- let yl = logand y halfmask and yh = shift_right_logical y halfsize in
- add2 (mul xh yh, 0n)
- (add2 (shl2 (0n, mul xl yh) halfsize)
- (add2 (shl2 (0n, mul xh yl) halfsize)
- (0n, mul xl yl)))
-
-let ucompare2 (xh, xl) (yh, yl) =
- let c = ucompare xh yh in if c = 0 then ucompare xl yl else c
-
-let validate d m p =
- let md = mul2 m d in
- let one2 = (0n, 1n) in
- let twoszp = shl2 one2 (size + p) in
- let twop1 = shl2 one2 (p + 1) in
- ucompare2 twoszp md < 0 && ucompare2 md (add2 twoszp twop1) <= 0
-*)
-
-let raise_regular dbg exc =
- Csequence(
- Cop(Cstore (Thirtytwo_signed, Assignment),
- [(Cconst_symbol ("caml_backtrace_pos", dbg));
- Cconst_int (0, dbg)], dbg),
- Cop(Craise Raise_withtrace,[exc], dbg))
-
-let raise_symbol dbg symb =
- raise_regular dbg (Cconst_symbol (symb, dbg))
-
-let rec div_int c1 c2 is_safe dbg =
- match (c1, c2) with
- (c1, Cconst_int (0, _)) ->
- Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
- | (c1, Cconst_int (1, _)) ->
- c1
- | (Cconst_int (n1, _), Cconst_int (n2, _)) ->
- Cconst_int (n1 / n2, dbg)
- | (c1, Cconst_int (n, _)) when n <> min_int ->
- let l = Misc.log2 n in
- if n = 1 lsl l then
- (* Algorithm:
- t = shift-right-signed(c1, l - 1)
- t = shift-right(t, W - l)
- t = c1 + t
- res = shift-right-signed(c1 + t, l)
- *)
- Cop(Casr, [bind "dividend" c1 (fun c1 ->
- let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
- let t =
- lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg
- in
- add_int c1 t dbg);
- Cconst_int (l, dbg)], dbg)
- else if n < 0 then
- sub_int (Cconst_int (0, dbg))
- (div_int c1 (Cconst_int (-n, dbg)) is_safe dbg)
- dbg
- else begin
- let (m, p) = divimm_parameters (Nativeint.of_int n) in
- (* Algorithm:
- t = multiply-high-signed(c1, m)
- if m < 0, t = t + c1
- if p > 0, t = shift-right-signed(t, p)
- res = t + sign-bit(c1)
- *)
- bind "dividend" c1 (fun c1 ->
- let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in
- let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in
- let t =
- if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t
- in
- add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1, dbg)) dbg) dbg)
- end
- | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
- Cop(Cdivi, [c1; c2], dbg)
- | (c1, c2) ->
- bind "divisor" c2 (fun c2 ->
- bind "dividend" c1 (fun c1 ->
- Cifthenelse(c2,
- dbg,
- Cop(Cdivi, [c1; c2], dbg),
- dbg,
- raise_symbol dbg "caml_exn_Division_by_zero",
- dbg)))
-
-let mod_int c1 c2 is_safe dbg =
- match (c1, c2) with
- (c1, Cconst_int (0, _)) ->
- Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
- | (c1, Cconst_int ((1 | (-1)), _)) ->
- Csequence(c1, Cconst_int (0, dbg))
- | (Cconst_int (n1, _), Cconst_int (n2, _)) ->
- Cconst_int (n1 mod n2, dbg)
- | (c1, (Cconst_int (n, _) as c2)) when n <> min_int ->
- let l = Misc.log2 n in
- if n = 1 lsl l then
- (* Algorithm:
- t = shift-right-signed(c1, l - 1)
- t = shift-right(t, W - l)
- t = c1 + t
- t = bit-and(t, -n)
- res = c1 - t
- *)
- bind "dividend" c1 (fun c1 ->
- let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
- let t = lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg in
- let t = add_int c1 t dbg in
- let t = Cop(Cand, [t; Cconst_int (-n, dbg)], dbg) in
- sub_int c1 t dbg)
- else
- bind "dividend" c1 (fun c1 ->
- sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2 dbg) dbg)
- | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
- (* Flambda already generates that test *)
- Cop(Cmodi, [c1; c2], dbg)
- | (c1, c2) ->
- bind "divisor" c2 (fun c2 ->
- bind "dividend" c1 (fun c1 ->
- Cifthenelse(c2,
- dbg,
- Cop(Cmodi, [c1; c2], dbg),
- dbg,
- raise_symbol dbg "caml_exn_Division_by_zero",
- dbg)))
-
-(* Division or modulo on boxed integers. The overflow case min_int / -1
- can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)
-
-let is_different_from x = function
- Cconst_int (n, _) -> n <> x
- | Cconst_natint (n, _) -> n <> Nativeint.of_int x
- | _ -> false
-
-let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg =
- bind "dividend" c1 (fun c1 ->
- bind "divisor" c2 (fun c2 ->
- let c = mkop c1 c2 is_safe dbg in
- if Arch.division_crashes_on_overflow
- && (size_int = 4 || bi <> Pint32)
- && not (is_different_from (-1) c2)
- then
- Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int (-1, dbg)], dbg),
- dbg, c,
- dbg, mkm1 c1 dbg,
- dbg)
- else
- c))
-
-let safe_div_bi is_safe =
- safe_divmod_bi div_int is_safe
- (fun c1 dbg -> Cop(Csubi, [Cconst_int (0, dbg); c1], dbg))
-
-let safe_mod_bi is_safe =
- safe_divmod_bi mod_int is_safe (fun _ dbg -> Cconst_int (0, dbg))
-
-(* Bool *)
-
-let test_bool dbg cmm =
- match cmm with
- | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) ->
- c
- | Cconst_int (n, dbg) ->
- if n = 1 then
- Cconst_int (0, dbg)
- else
- Cconst_int (1, dbg)
- | c -> Cop(Ccmpi Cne, [c; Cconst_int (1, dbg)], dbg)
-
-(* Float *)
-
-let box_float dbg c = Cop(Calloc, [alloc_float_header dbg; c], dbg)
-
-let map_ccatch f rec_flag handlers body =
- let handlers = List.map
- (fun (n, ids, handler, dbg) -> (n, ids, f handler, dbg))
- handlers in
- Ccatch(rec_flag, handlers, f body)
-
-let rec unbox_float dbg cmm =
- match cmm with
- | Cop(Calloc, [Cblockheader (header, _); c], _) when header = float_header ->
- c
- | Clet(id, exp, body) -> Clet(id, exp, unbox_float dbg body)
- | Cifthenelse(cond, ifso_dbg, e1, ifnot_dbg, e2, dbg) ->
- Cifthenelse(cond,
- ifso_dbg, unbox_float dbg e1,
- ifnot_dbg, unbox_float dbg e2,
- dbg)
- | Csequence(e1, e2) -> Csequence(e1, unbox_float dbg e2)
- | Cswitch(e, tbl, el, dbg') ->
- Cswitch(e, tbl,
- Array.map (fun (expr, dbg) -> unbox_float dbg expr, dbg) el, dbg')
- | Ccatch(rec_flag, handlers, body) ->
- map_ccatch (unbox_float dbg) rec_flag handlers body
- | Ctrywith(e1, id, e2, dbg) ->
- Ctrywith(unbox_float dbg e1, id, unbox_float dbg e2, dbg)
- | c -> Cop(Cload (Double_u, Immutable), [c], dbg)
-
-(* Complex *)
-
-let box_complex dbg c_re c_im =
- Cop(Calloc, [alloc_floatarray_header 2 dbg; c_re; c_im], dbg)
-
-let complex_re c dbg = Cop(Cload (Double_u, Immutable), [c], dbg)
-let complex_im c dbg = Cop(Cload (Double_u, Immutable),
- [Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)],
- dbg)
-
-(* Unit *)
-
-let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg))
-
-let rec remove_unit = function
- Cconst_pointer (1, _) -> Ctuple []
- | Csequence(c, Cconst_pointer (1, _)) -> c
- | Csequence(c1, c2) ->
- Csequence(c1, remove_unit c2)
- | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
- Cifthenelse(cond,
- ifso_dbg, remove_unit ifso,
- ifnot_dbg,
- remove_unit ifnot, dbg)
- | Cswitch(sel, index, cases, dbg) ->
- Cswitch(sel, index,
- Array.map (fun (case, dbg) -> remove_unit case, dbg) cases,
- dbg)
- | Ccatch(rec_flag, handlers, body) ->
- map_ccatch remove_unit rec_flag handlers body
- | Ctrywith(body, exn, handler, dbg) ->
- Ctrywith(remove_unit body, exn, remove_unit handler, dbg)
- | Clet(id, c1, c2) ->
- Clet(id, c1, remove_unit c2)
- | Cop(Capply _mty, args, dbg) ->
- Cop(Capply typ_void, args, dbg)
- | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) ->
- Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg)
- | Cexit (_,_) as c -> c
- | Ctuple [] as c -> c
- | c -> Csequence(c, Ctuple [])
-
-(* Access to block fields *)
-
-let field_address ptr n dbg =
- if n = 0
- then ptr
- else Cop(Cadda, [ptr; Cconst_int(n * size_addr, dbg)], dbg)
+let mut_from_env env ptr =
+ match env.environment_param with
+ | None -> Mutable
+ | Some environment_param ->
+ match ptr with
+ | Cvar ptr ->
+ (* Loads from the current function's closure are immutable. *)
+ if V.same environment_param ptr then Immutable
+ else Mutable
+ | _ -> Mutable
let get_field env ptr n dbg =
- let mut =
- match env.environment_param with
- | None -> Mutable
- | Some environment_param ->
- match ptr with
- | Cvar ptr ->
- (* Loads from the current function's closure are immutable. *)
- if V.same environment_param ptr then Immutable
- else Mutable
- | _ -> Mutable
- in
- Cop(Cload (Word_val, mut), [field_address ptr n dbg], dbg)
-
-let set_field ptr n newval init dbg =
- Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg)
-
-let non_profinfo_mask =
- if Config.profinfo
- then (1 lsl (64 - Config.profinfo_width)) - 1
- else 0 (* [non_profinfo_mask] is unused in this case *)
-
-let get_header ptr dbg =
- (* We cannot deem this as [Immutable] due to the presence of [Obj.truncate]
- and [Obj.set_tag]. *)
- Cop(Cload (Word_int, Mutable),
- [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg)
-
-let get_header_without_profinfo ptr dbg =
- if Config.profinfo then
- Cop(Cand, [get_header ptr dbg; Cconst_int (non_profinfo_mask, dbg)], dbg)
- else
- get_header ptr dbg
-
-let tag_offset =
- if big_endian then -1 else -size_int
-
-let get_tag ptr dbg =
- if Proc.word_addressed then (* If byte loads are slow *)
- Cop(Cand, [get_header ptr dbg; Cconst_int (255, dbg)], dbg)
- else (* If byte loads are efficient *)
- Cop(Cload (Byte_unsigned, Mutable), (* Same comment as [get_header] above *)
- [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg)
-
-let get_size ptr dbg =
- Cop(Clsr, [get_header_without_profinfo ptr dbg; Cconst_int (10, dbg)], dbg)
-
-(* Array indexing *)
-
-let log2_size_addr = Misc.log2 size_addr
-let log2_size_float = Misc.log2 size_float
-
-let wordsize_shift = 9
-let numfloat_shift = 9 + log2_size_float - log2_size_addr
-
-let is_addr_array_hdr hdr dbg =
- Cop(Ccmpi Cne,
- [Cop(Cand, [hdr; Cconst_int (255, dbg)], dbg); floatarray_tag dbg],
- dbg)
-
-let is_addr_array_ptr ptr dbg =
- Cop(Ccmpi Cne, [get_tag ptr dbg; floatarray_tag dbg], dbg)
-
-let addr_array_length hdr dbg =
- Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg)
-let float_array_length hdr dbg =
- Cop(Clsr, [hdr; Cconst_int (numfloat_shift, dbg)], dbg)
-
-let lsl_const c n dbg =
- if n = 0 then c
- else Cop(Clsl, [c; Cconst_int (n, dbg)], dbg)
-
-(* Produces a pointer to the element of the array [ptr] on the position [ofs]
- with the given element [log2size] log2 element size. [ofs] is given as a
- tagged int expression.
- The optional ?typ argument is the C-- type of the result.
- By default, it is Addr, meaning we are constructing a derived pointer
- into the heap. If we know the pointer is outside the heap
- (this is the case for bigarray indexing), we give type Int instead. *)
-
-let array_indexing ?typ log2size ptr ofs dbg =
- let add =
- match typ with
- | None | Some Addr -> Cadda
- | Some Int -> Caddi
- | _ -> assert false in
- match ofs with
- | Cconst_int (n, _) ->
- let i = n asr 1 in
- if i = 0 then ptr
- else Cop(add, [ptr; Cconst_int(i lsl log2size, dbg)], dbg)
- | Cop(Caddi,
- [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') ->
- Cop(add, [ptr; lsl_const c log2size dbg], dbg')
- | Cop(Caddi, [c; Cconst_int (n, _)], dbg') when log2size = 0 ->
- Cop(add,
- [Cop(add, [ptr; untag_int c dbg], dbg); Cconst_int (n asr 1, dbg)],
- dbg')
- | Cop(Caddi, [c; Cconst_int (n, _)], _) ->
- Cop(add, [Cop(add, [ptr; lsl_const c (log2size - 1) dbg], dbg);
- Cconst_int((n-1) lsl (log2size - 1), dbg)], dbg)
- | _ when log2size = 0 ->
- Cop(add, [ptr; untag_int ofs dbg], dbg)
- | _ ->
- Cop(add, [Cop(add, [ptr; lsl_const ofs (log2size - 1) dbg], dbg);
- Cconst_int((-1) lsl (log2size - 1), dbg)], dbg)
-
-let addr_array_ref arr ofs dbg =
- Cop(Cload (Word_val, Mutable),
- [array_indexing log2_size_addr arr ofs dbg], dbg)
-let int_array_ref arr ofs dbg =
- Cop(Cload (Word_int, Mutable),
- [array_indexing log2_size_addr arr ofs dbg], dbg)
-let unboxed_float_array_ref arr ofs dbg =
- Cop(Cload (Double_u, Mutable),
- [array_indexing log2_size_float arr ofs dbg], dbg)
-let float_array_ref dbg arr ofs =
- box_float dbg (unboxed_float_array_ref arr ofs dbg)
-
-let addr_array_set arr ofs newval dbg =
- Cop(Cextcall("caml_modify", typ_void, false, None),
- [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
-let addr_array_initialize arr ofs newval dbg =
- Cop(Cextcall("caml_initialize", typ_void, false, None),
- [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
-let int_array_set arr ofs newval dbg =
- Cop(Cstore (Word_int, Assignment),
- [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
-let float_array_set arr ofs newval dbg =
- Cop(Cstore (Double_u, Assignment),
- [array_indexing log2_size_float arr ofs dbg; newval], dbg)
-
-(* String length *)
-
-(* Length of string block *)
-
-let string_length exp dbg =
- bind "str" exp (fun str ->
- let tmp_var = V.create_local "*tmp*" in
- Clet(VP.create tmp_var,
- Cop(Csubi,
- [Cop(Clsl,
- [get_size str dbg;
- Cconst_int (log2_size_addr, dbg)],
- dbg);
- Cconst_int (1, dbg)],
- dbg),
- Cop(Csubi,
- [Cvar tmp_var;
- Cop(Cload (Byte_unsigned, Mutable),
- [Cop(Cadda, [str; Cvar tmp_var], dbg)], dbg)], dbg)))
-
-let bigstring_length ba dbg =
- Cop(Cload (Word_int, Mutable), [field_address ba 5 dbg], dbg)
-
-(* Message sending *)
-
-let lookup_tag obj tag dbg =
- bind "tag" tag (fun tag ->
- Cop(Cextcall("caml_get_public_method", typ_val, false, None),
- [obj; tag],
- dbg))
-
-let lookup_label obj lab dbg =
- bind "lab" lab (fun lab ->
- let table = Cop (Cload (Word_val, Mutable), [obj], dbg) in
- addr_array_ref table lab dbg)
-
-let call_cached_method obj tag cache pos args dbg =
- let arity = List.length args in
- let cache = array_indexing log2_size_addr cache pos dbg in
- Compilenv.need_send_fun arity;
- Cop(Capply typ_val,
- Cconst_symbol("caml_send" ^ Int.to_string arity, dbg) ::
- obj :: tag :: cache :: args,
- dbg)
-
-(* Allocation *)
-
-let make_alloc_generic set_fn dbg tag wordsize args =
- if wordsize <= Config.max_young_wosize then
- Cop(Calloc, Cblockheader(block_header tag wordsize, dbg) :: args, dbg)
- else begin
- let id = V.create_local "*alloc*" in
- let rec fill_fields idx = function
- [] -> Cvar id
- | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg,
- fill_fields (idx + 2) el) in
- Clet(VP.create id,
- Cop(Cextcall("caml_alloc", typ_val, true, None),
- [Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg),
- fill_fields 1 args)
- end
-
-let make_alloc dbg tag args =
- let addr_array_init arr ofs newval dbg =
- Cop(Cextcall("caml_initialize", typ_void, false, None),
- [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
- in
- make_alloc_generic addr_array_init dbg tag (List.length args) args
-
-let make_float_alloc dbg tag args =
- make_alloc_generic float_array_set dbg tag
- (List.length args * size_float / size_addr) args
-
-(* Bounds checking *)
-
-let make_checkbound dbg = function
- | [Cop(Clsr, [a1; Cconst_int (n, _)], _); Cconst_int (m, _)]
- when (m lsl n) > n ->
- Cop(Ccheckbound, [a1; Cconst_int(m lsl n + 1 lsl n - 1, dbg)], dbg)
- | args ->
- Cop(Ccheckbound, args, dbg)
-
-(* To compile "let rec" over values *)
-
-let fundecls_size fundecls =
- let sz = ref (-1) in
- List.iter
- (fun f ->
- let indirect_call_code_pointer_size =
- match f.arity with
- | 0 | 1 -> 0
- (* arity 1 does not need an indirect call handler.
- arity 0 cannot be indirect called *)
- | _ -> 1
- (* For other arities there is an indirect call handler.
- if arity >= 2 it is caml_curry...
- if arity < 0 it is caml_tuplify... *)
- in
- sz := !sz + 1 + 2 + indirect_call_code_pointer_size)
- fundecls;
- !sz
+ let mut = mut_from_env env ptr in
+ get_field_gen mut ptr n dbg
type rhs_kind =
| RHS_block of int
| RHS_floatblock of int
| RHS_nonrec
;;
+
let rec expr_size env = function
| Uvar id ->
begin try V.find_same id env with Not_found -> RHS_nonrec end
| _ -> assert false)
| _ -> RHS_nonrec
-(* Record application and currying functions *)
-
-let apply_function n =
- Compilenv.need_apply_fun n; "caml_apply" ^ Int.to_string n
-let curry_function n =
- Compilenv.need_curry_fun n;
- if n >= 0
- then "caml_curry" ^ Int.to_string n
- else "caml_tuplify" ^ Int.to_string (-n)
-
-(* Comparisons *)
-
-let transl_int_comparison cmp = cmp
-
-let transl_float_comparison cmp = cmp
-
(* Translate structured constants to Cmm data items *)
let transl_constant dbg = function
| Uconst_ref (label, _) ->
Cconst_symbol (label, dbg)
-let cdefine_symbol (symb, (global : Cmmgen_state.is_global)) =
- match global with
- | Global -> [Cglobal_symbol symb; Cdefine_symbol symb]
- | Local -> [Cdefine_symbol symb]
-
-let emit_block symb is_global white_header cont =
- (* Headers for structured constants must be marked black in case we
- are in no-naked-pointers mode. See [caml_darken]. *)
- let black_header = Nativeint.logor white_header caml_black in
- Cint black_header :: cdefine_symbol (symb, is_global) @ cont
+let emit_constant cst cont =
+ match cst with
+ | Uconst_int n | Uconst_ptr n ->
+ cint_const n
+ :: cont
+ | Uconst_ref (sym, _) ->
+ Csymbol_address sym :: cont
-let rec emit_structured_constant (sym, is_global) cst cont =
+let emit_structured_constant ((_sym, is_global) as symb) cst cont =
match cst with
| Uconst_float s ->
- emit_block sym is_global float_header (Cdouble s :: cont)
+ emit_float_constant symb s cont
| Uconst_string s ->
- emit_block sym is_global (string_header (String.length s))
- (emit_string_constant s cont)
+ emit_string_constant symb s cont
| Uconst_int32 n ->
- emit_block sym is_global boxedint32_header
- (emit_boxed_int32_constant n cont)
+ emit_int32_constant symb n cont
| Uconst_int64 n ->
- emit_block sym is_global boxedint64_header
- (emit_boxed_int64_constant n cont)
+ emit_int64_constant symb n cont
| Uconst_nativeint n ->
- emit_block sym is_global boxedintnat_header
- (emit_boxed_nativeint_constant n cont)
+ emit_nativeint_constant symb n cont
| Uconst_block (tag, csts) ->
let cont = List.fold_right emit_constant csts cont in
- emit_block sym is_global (block_header tag (List.length csts)) cont
+ emit_block symb (block_header tag (List.length csts)) cont
| Uconst_float_array fields ->
- emit_block sym is_global (floatarray_header (List.length fields))
- (Misc.map_end (fun f -> Cdouble f) fields cont)
+ emit_float_array_constant symb fields cont
| Uconst_closure(fundecls, lbl, fv) ->
Cmmgen_state.add_constant lbl (Const_closure (is_global, fundecls, fv));
List.iter (fun f -> Cmmgen_state.add_function f) fundecls;
cont
-and emit_constant cst cont =
- match cst with
- | Uconst_int n | Uconst_ptr n ->
- cint_const n
- :: cont
- | Uconst_ref (sym, _) ->
- Csymbol_address sym :: cont
-
-and emit_string_constant s cont =
- let n = size_int - 1 - (String.length s) mod size_int in
- Cstring s :: Cskip n :: Cint8 n :: cont
-
-and emit_boxed_int32_constant n cont =
- let n = Nativeint.of_int32 n in
- if size_int = 8 then
- Csymbol_address caml_int32_ops :: Cint32 n :: Cint32 0n :: cont
- else
- Csymbol_address caml_int32_ops :: Cint n :: cont
-
-and emit_boxed_nativeint_constant n cont =
- Csymbol_address caml_nativeint_ops :: Cint n :: cont
-
-and emit_boxed_int64_constant n cont =
- let lo = Int64.to_nativeint n in
- if size_int = 8 then
- Csymbol_address caml_int64_ops :: Cint lo :: cont
- else begin
- let hi = Int64.to_nativeint (Int64.shift_right n 32) in
- if big_endian then
- Csymbol_address caml_int64_ops :: Cint hi :: Cint lo :: cont
- else
- Csymbol_address caml_int64_ops :: Cint lo :: Cint hi :: cont
- end
-
(* Boxed integers *)
let box_int_constant sym bi n =
match bi with
Pnativeint ->
- emit_block sym Local boxedintnat_header
- (emit_boxed_nativeint_constant n [])
+ emit_nativeint_constant (sym, Local) n []
| Pint32 ->
let n = Nativeint.to_int32 n in
- emit_block sym Local boxedint32_header
- (emit_boxed_int32_constant n [])
+ emit_int32_constant (sym, Local) n []
| Pint64 ->
let n = Int64.of_nativeint n in
- emit_block sym Local boxedint64_header
- (emit_boxed_int64_constant n [])
-
-let operations_boxed_int bi =
- match bi with
- Pnativeint -> caml_nativeint_ops
- | Pint32 -> caml_int32_ops
- | Pint64 -> caml_int64_ops
-
-let alloc_header_boxed_int bi =
- match bi with
- Pnativeint -> alloc_boxedintnat_header
- | Pint32 -> alloc_boxedint32_header
- | Pint64 -> alloc_boxedint64_header
+ emit_int64_constant (sym, Local) n []
let box_int dbg bi arg =
match arg with
Cmmgen_state.add_data_items data_items;
Cconst_symbol (sym, dbg)
| _ ->
- let arg' =
- if bi = Pint32 && size_int = 8 && big_endian
- then Cop(Clsl, [arg; Cconst_int (32, dbg)], dbg)
- else arg in
- Cop(Calloc, [alloc_header_boxed_int bi dbg;
- Cconst_symbol(operations_boxed_int bi, dbg);
- arg'], dbg)
-
-let split_int64_for_32bit_target arg dbg =
- bind "split_int64" arg (fun arg ->
- let first = Cop (Cadda, [Cconst_int (size_int, dbg); arg], dbg) in
- let second = Cop (Cadda, [Cconst_int (2 * size_int, dbg); arg], dbg) in
- Ctuple [Cop (Cload (Thirtytwo_unsigned, Mutable), [first], dbg);
- Cop (Cload (Thirtytwo_unsigned, Mutable), [second], dbg)])
-
-let alloc_matches_boxed_int bi ~hdr ~ops =
- match bi, hdr, ops with
- | Pnativeint, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
- Nativeint.equal hdr boxedintnat_header
- && String.equal sym caml_nativeint_ops
- | Pint32, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
- Nativeint.equal hdr boxedint32_header
- && String.equal sym caml_int32_ops
- | Pint64, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
- Nativeint.equal hdr boxedint64_header
- && String.equal sym caml_int64_ops
- | (Pnativeint | Pint32 | Pint64), _, _ -> false
-
-let rec unbox_int bi arg dbg =
- match arg with
- Cop(Calloc, [hdr; ops; Cop(Clsl, [contents; Cconst_int (32, _)], dbg')],
- _dbg)
- when bi = Pint32 && size_int = 8 && big_endian
- && alloc_matches_boxed_int bi ~hdr ~ops ->
- (* Force sign-extension of low 32 bits *)
- Cop(Casr, [Cop(Clsl, [contents; Cconst_int (32, dbg)], dbg');
- Cconst_int (32, dbg)],
- dbg)
- | Cop(Calloc, [hdr; ops; contents], _dbg)
- when bi = Pint32 && size_int = 8 && not big_endian
- && alloc_matches_boxed_int bi ~hdr ~ops ->
- (* Force sign-extension of low 32 bits *)
- Cop(Casr, [Cop(Clsl, [contents; Cconst_int (32, dbg)], dbg);
- Cconst_int (32, dbg)],
- dbg)
- | Cop(Calloc, [hdr; ops; contents], _dbg)
- when alloc_matches_boxed_int bi ~hdr ~ops ->
- contents
- | Clet(id, exp, body) -> Clet(id, exp, unbox_int bi body dbg)
- | Cifthenelse(cond, ifso_dbg, e1, ifnot_dbg, e2, dbg) ->
- Cifthenelse(cond,
- ifso_dbg, unbox_int bi e1 ifso_dbg,
- ifnot_dbg, unbox_int bi e2 ifnot_dbg,
- dbg)
- | Csequence(e1, e2) -> Csequence(e1, unbox_int bi e2 dbg)
- | Cswitch(e, tbl, el, dbg') ->
- Cswitch(e, tbl,
- Array.map (fun (e, dbg) -> unbox_int bi e dbg, dbg) el,
- dbg')
- | Ccatch(rec_flag, handlers, body) ->
- map_ccatch (fun e -> unbox_int bi e dbg) rec_flag handlers body
- | Ctrywith(e1, id, e2, handler_dbg) ->
- Ctrywith(unbox_int bi e1 dbg, id,
- unbox_int bi e2 handler_dbg, handler_dbg)
- | _ ->
- if size_int = 4 && bi = Pint64 then
- split_int64_for_32bit_target arg dbg
- else
- Cop(
- Cload((if bi = Pint32 then Thirtytwo_signed else Word_int), Mutable),
- [Cop(Cadda, [arg; Cconst_int (size_addr, dbg)], dbg)], dbg)
-
-let make_unsigned_int bi arg dbg =
- if bi = Pint32 && size_int = 8
- then Cop(Cand, [arg; Cconst_natint (0xFFFFFFFFn, dbg)], dbg)
- else arg
+ box_int_gen dbg bi arg
(* Boxed numbers *)
| Boxed_float dbg -> box_float dbg arg
| Boxed_integer (bi, dbg) -> box_int dbg bi arg
-(* Big arrays *)
-
-let bigarray_elt_size = function
- Pbigarray_unknown -> assert false
- | Pbigarray_float32 -> 4
- | Pbigarray_float64 -> 8
- | Pbigarray_sint8 -> 1
- | Pbigarray_uint8 -> 1
- | Pbigarray_sint16 -> 2
- | Pbigarray_uint16 -> 2
- | Pbigarray_int32 -> 4
- | Pbigarray_int64 -> 8
- | Pbigarray_caml_int -> size_int
- | Pbigarray_native_int -> size_int
- | Pbigarray_complex32 -> 8
- | Pbigarray_complex64 -> 16
-
-(* Produces a pointer to the element of the bigarray [b] on the position
- [args]. [args] is given as a list of tagged int expressions, one per array
- dimension. *)
-let bigarray_indexing unsafe elt_kind layout b args dbg =
- let check_ba_bound bound idx v =
- Csequence(make_checkbound dbg [bound;idx], v) in
- (* Validates the given multidimensional offset against the array bounds and
- transforms it into a one dimensional offset. The offsets are expressions
- evaluating to tagged int. *)
- let rec ba_indexing dim_ofs delta_ofs = function
- [] -> assert false
- | [arg] ->
- if unsafe then arg
- else
- bind "idx" arg (fun idx ->
- (* Load the untagged int bound for the given dimension *)
- let bound =
- Cop(Cload (Word_int, Mutable),[field_address b dim_ofs dbg], dbg)
- in
- let idxn = untag_int idx dbg in
- check_ba_bound bound idxn idx)
- | arg1 :: argl ->
- (* The remainder of the list is transformed into a one dimensional offset
- *)
- let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in
- (* Load the untagged int bound for the given dimension *)
- let bound =
- Cop(Cload (Word_int, Mutable), [field_address b dim_ofs dbg], dbg)
- in
- if unsafe then add_int (mul_int (decr_int rem dbg) bound dbg) arg1 dbg
- else
- bind "idx" arg1 (fun idx ->
- bind "bound" bound (fun bound ->
- let idxn = untag_int idx dbg in
- (* [offset = rem * (tag_int bound) + idx] *)
- let offset =
- add_int (mul_int (decr_int rem dbg) bound dbg) idx dbg
- in
- check_ba_bound bound idxn offset)) in
- (* The offset as an expression evaluating to int *)
- let offset =
- match layout with
- Pbigarray_unknown_layout ->
- assert false
- | Pbigarray_c_layout ->
- ba_indexing (4 + List.length args) (-1) (List.rev args)
- | Pbigarray_fortran_layout ->
- ba_indexing 5 1
- (List.map (fun idx -> sub_int idx (Cconst_int (2, dbg)) dbg) args)
- and elt_size =
- bigarray_elt_size elt_kind in
- (* [array_indexing] can simplify the given expressions *)
- array_indexing ~typ:Addr (log2 elt_size)
- (Cop(Cload (Word_int, Mutable),
- [field_address b 1 dbg], dbg)) offset dbg
-
-let bigarray_word_kind = function
- Pbigarray_unknown -> assert false
- | Pbigarray_float32 -> Single
- | Pbigarray_float64 -> Double
- | Pbigarray_sint8 -> Byte_signed
- | Pbigarray_uint8 -> Byte_unsigned
- | Pbigarray_sint16 -> Sixteen_signed
- | Pbigarray_uint16 -> Sixteen_unsigned
- | Pbigarray_int32 -> Thirtytwo_signed
- | Pbigarray_int64 -> Word_int
- | Pbigarray_caml_int -> Word_int
- | Pbigarray_native_int -> Word_int
- | Pbigarray_complex32 -> Single
- | Pbigarray_complex64 -> Double
-
-let bigarray_get unsafe elt_kind layout b args dbg =
- bind "ba" b (fun b ->
- match elt_kind with
- Pbigarray_complex32 | Pbigarray_complex64 ->
- let kind = bigarray_word_kind elt_kind in
- let sz = bigarray_elt_size elt_kind / 2 in
- bind "addr"
- (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr ->
- bind "reval"
- (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval ->
- bind "imval"
- (Cop(Cload (kind, Mutable),
- [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg)], dbg))
- (fun imval -> box_complex dbg reval imval)))
- | _ ->
- Cop(Cload (bigarray_word_kind elt_kind, Mutable),
- [bigarray_indexing unsafe elt_kind layout b args dbg],
- dbg))
-
-let bigarray_set unsafe elt_kind layout b args newval dbg =
- bind "ba" b (fun b ->
- match elt_kind with
- Pbigarray_complex32 | Pbigarray_complex64 ->
- let kind = bigarray_word_kind elt_kind in
- let sz = bigarray_elt_size elt_kind / 2 in
- bind "newval" newval (fun newv ->
- bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg)
- (fun addr ->
- Csequence(
- Cop(Cstore (kind, Assignment), [addr; complex_re newv dbg], dbg),
- Cop(Cstore (kind, Assignment),
- [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg);
- complex_im newv dbg],
- dbg))))
- | _ ->
- Cop(Cstore (bigarray_word_kind elt_kind, Assignment),
- [bigarray_indexing unsafe elt_kind layout b args dbg; newval],
- dbg))
-
-let unaligned_load_16 ptr idx dbg =
- if Arch.allow_unaligned_access
- then Cop(Cload (Sixteen_unsigned, Mutable), [add_int ptr idx dbg], dbg)
- else
- let cconst_int i = Cconst_int (i, dbg) in
- let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
- let v2 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
- in
- let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
- Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg)
-
-let unaligned_set_16 ptr idx newval dbg =
- if Arch.allow_unaligned_access
- then
- Cop(Cstore (Sixteen_unsigned, Assignment),
- [add_int ptr idx dbg; newval], dbg)
- else
- let cconst_int i = Cconst_int (i, dbg) in
- let v1 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg);
- cconst_int 0xFF], dbg)
- in
- let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
- let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg))
-
-let unaligned_load_32 ptr idx dbg =
- if Arch.allow_unaligned_access
- then Cop(Cload (Thirtytwo_unsigned, Mutable), [add_int ptr idx dbg], dbg)
- else
- let cconst_int i = Cconst_int (i, dbg) in
- let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
- let v2 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
- in
- let v3 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg)
- in
- let v4 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg)
- in
- let b1, b2, b3, b4 =
- if Arch.big_endian
- then v1, v2, v3, v4
- else v4, v3, v2, v1 in
- Cop(Cor,
- [Cop(Cor, [lsl_int b1 (cconst_int 24) dbg;
- lsl_int b2 (cconst_int 16) dbg], dbg);
- Cop(Cor, [lsl_int b3 (cconst_int 8) dbg; b4], dbg)],
- dbg)
-
-let unaligned_set_32 ptr idx newval dbg =
- if Arch.allow_unaligned_access
- then
- Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval],
- dbg)
- else
- let cconst_int i = Cconst_int (i, dbg) in
- let v1 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg)
- in
- let v2 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg)
- in
- let v3 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg)
- in
- let v4 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
- let b1, b2, b3, b4 =
- if Arch.big_endian
- then v1, v2, v3, v4
- else v4, v3, v2, v1 in
- Csequence(
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int ptr idx dbg; b1], dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
- dbg)),
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
- dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
- dbg)))
-
-let unaligned_load_64 ptr idx dbg =
- assert(size_int = 8);
- if Arch.allow_unaligned_access
- then Cop(Cload (Word_int, Mutable), [add_int ptr idx dbg], dbg)
- else
- let cconst_int i = Cconst_int (i, dbg) in
- let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
- let v2 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
- in
- let v3 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg)
- in
- let v4 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg)
- in
- let v5 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg)
- in
- let v6 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg)
- in
- let v7 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg)
- in
- let v8 = Cop(Cload (Byte_unsigned, Mutable),
- [add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg)
- in
- let b1, b2, b3, b4, b5, b6, b7, b8 =
- if Arch.big_endian
- then v1, v2, v3, v4, v5, v6, v7, v8
- else v8, v7, v6, v5, v4, v3, v2, v1 in
- Cop(Cor,
- [Cop(Cor,
- [Cop(Cor, [lsl_int b1 (cconst_int (8*7)) dbg;
- lsl_int b2 (cconst_int (8*6)) dbg], dbg);
- Cop(Cor, [lsl_int b3 (cconst_int (8*5)) dbg;
- lsl_int b4 (cconst_int (8*4)) dbg], dbg)],
- dbg);
- Cop(Cor,
- [Cop(Cor, [lsl_int b5 (cconst_int (8*3)) dbg;
- lsl_int b6 (cconst_int (8*2)) dbg], dbg);
- Cop(Cor, [lsl_int b7 (cconst_int 8) dbg;
- b8], dbg)],
- dbg)], dbg)
-
-let unaligned_set_64 ptr idx newval dbg =
- assert(size_int = 8);
- if Arch.allow_unaligned_access
- then Cop(Cstore (Word_int, Assignment), [add_int ptr idx dbg; newval], dbg)
- else
- let cconst_int i = Cconst_int (i, dbg) in
- let v1 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*7)], dbg); cconst_int 0xFF],
- dbg)
- in
- let v2 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*6)], dbg); cconst_int 0xFF],
- dbg)
- in
- let v3 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*5)], dbg); cconst_int 0xFF],
- dbg)
- in
- let v4 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*4)], dbg); cconst_int 0xFF],
- dbg)
- in
- let v5 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*3)], dbg); cconst_int 0xFF],
- dbg)
- in
- let v6 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*2)], dbg); cconst_int 0xFF],
- dbg)
- in
- let v7 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF],
- dbg)
- in
- let v8 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
- let b1, b2, b3, b4, b5, b6, b7, b8 =
- if Arch.big_endian
- then v1, v2, v3, v4, v5, v6, v7, v8
- else v8, v7, v6, v5, v4, v3, v2, v1 in
- Csequence(
- Csequence(
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int ptr idx dbg; b1],
- dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
- dbg)),
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
- dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
- dbg))),
- Csequence(
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5],
- dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6],
- dbg)),
- Csequence(
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7],
- dbg),
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
- dbg))))
-
-let max_or_zero a dbg =
- bind "size" a (fun a ->
- (* equivalent to
- Cifthenelse(Cop(Ccmpi Cle, [a; cconst_int 0]), cconst_int 0, a)
-
- if a is positive, sign is 0 hence sign_negation is full of 1
- so sign_negation&a = a
- if a is negative, sign is full of 1 hence sign_negation is 0
- so sign_negation&a = 0 *)
- let sign = Cop(Casr, [a; Cconst_int (size_int * 8 - 1, dbg)], dbg) in
- let sign_negation = Cop(Cxor, [sign; Cconst_int (-1, dbg)], dbg) in
- Cop(Cand, [sign_negation; a], dbg))
-
-let check_bound safety access_size dbg length a2 k =
- match safety with
- | Unsafe -> k
- | Safe ->
- let offset =
- match access_size with
- | Sixteen -> 1
- | Thirty_two -> 3
- | Sixty_four -> 7
- in
- let a1 =
- sub_int length (Cconst_int (offset, dbg)) dbg
- in
- Csequence(make_checkbound dbg [max_or_zero a1 dbg; a2], k)
-
-let unaligned_set size ptr idx newval dbg =
- match size with
- | Sixteen -> unaligned_set_16 ptr idx newval dbg
- | Thirty_two -> unaligned_set_32 ptr idx newval dbg
- | Sixty_four -> unaligned_set_64 ptr idx newval dbg
-
-let unaligned_load size ptr idx dbg =
- match size with
- | Sixteen -> unaligned_load_16 ptr idx dbg
- | Thirty_two -> unaligned_load_32 ptr idx dbg
- | Sixty_four -> unaligned_load_64 ptr idx dbg
-
-let box_sized size dbg exp =
- match size with
- | Sixteen -> tag_int exp dbg
- | Thirty_two -> box_int dbg Pint32 exp
- | Sixty_four -> box_int dbg Pint64 exp
-
-(* Simplification of some primitives into C calls *)
-
-let default_prim name =
- Primitive.simple ~name ~arity:0(*ignored*) ~alloc:true
-
-let int64_native_prim name arity ~alloc =
- let u64 = Unboxed_integer Pint64 in
- let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in
- Primitive.make ~name ~native_name:(name ^ "_native")
- ~alloc
- ~native_repr_args:(make_args arity)
- ~native_repr_res:u64
-
-let simplif_primitive_32bits = function
- Pbintofint Pint64 -> Pccall (default_prim "caml_int64_of_int")
- | Pintofbint Pint64 -> Pccall (default_prim "caml_int64_to_int")
- | Pcvtbint(Pint32, Pint64) -> Pccall (default_prim "caml_int64_of_int32")
- | Pcvtbint(Pint64, Pint32) -> Pccall (default_prim "caml_int64_to_int32")
- | Pcvtbint(Pnativeint, Pint64) ->
- Pccall (default_prim "caml_int64_of_nativeint")
- | Pcvtbint(Pint64, Pnativeint) ->
- Pccall (default_prim "caml_int64_to_nativeint")
- | Pnegbint Pint64 -> Pccall (int64_native_prim "caml_int64_neg" 1
- ~alloc:false)
- | Paddbint Pint64 -> Pccall (int64_native_prim "caml_int64_add" 2
- ~alloc:false)
- | Psubbint Pint64 -> Pccall (int64_native_prim "caml_int64_sub" 2
- ~alloc:false)
- | Pmulbint Pint64 -> Pccall (int64_native_prim "caml_int64_mul" 2
- ~alloc:false)
- | Pdivbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_div" 2
- ~alloc:true)
- | Pmodbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_mod" 2
- ~alloc:true)
- | Pandbint Pint64 -> Pccall (int64_native_prim "caml_int64_and" 2
- ~alloc:false)
- | Porbint Pint64 -> Pccall (int64_native_prim "caml_int64_or" 2
- ~alloc:false)
- | Pxorbint Pint64 -> Pccall (int64_native_prim "caml_int64_xor" 2
- ~alloc:false)
- | Plslbint Pint64 -> Pccall (default_prim "caml_int64_shift_left")
- | Plsrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right_unsigned")
- | Pasrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right")
- | Pbintcomp(Pint64, Lambda.Ceq) -> Pccall (default_prim "caml_equal")
- | Pbintcomp(Pint64, Lambda.Cne) -> Pccall (default_prim "caml_notequal")
- | Pbintcomp(Pint64, Lambda.Clt) -> Pccall (default_prim "caml_lessthan")
- | Pbintcomp(Pint64, Lambda.Cgt) -> Pccall (default_prim "caml_greaterthan")
- | Pbintcomp(Pint64, Lambda.Cle) -> Pccall (default_prim "caml_lessequal")
- | Pbintcomp(Pint64, Lambda.Cge) -> Pccall (default_prim "caml_greaterequal")
- | Pbigarrayref(_unsafe, n, Pbigarray_int64, _layout) ->
- Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n))
- | Pbigarrayset(_unsafe, n, Pbigarray_int64, _layout) ->
- Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n))
- | Pstring_load(Sixty_four, _) -> Pccall (default_prim "caml_string_get64")
- | Pbytes_load(Sixty_four, _) -> Pccall (default_prim "caml_bytes_get64")
- | Pbytes_set(Sixty_four, _) -> Pccall (default_prim "caml_bytes_set64")
- | Pbigstring_load(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_get64")
- | Pbigstring_set(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_set64")
- | Pbbswap Pint64 -> Pccall (default_prim "caml_int64_bswap")
- | p -> p
-
-let simplif_primitive p =
- match p with
- | Pduprecord _ ->
- Pccall (default_prim "caml_obj_dup")
- | Pbigarrayref(_unsafe, n, Pbigarray_unknown, _layout) ->
- Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n))
- | Pbigarrayset(_unsafe, n, Pbigarray_unknown, _layout) ->
- Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n))
- | Pbigarrayref(_unsafe, n, _kind, Pbigarray_unknown_layout) ->
- Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n))
- | Pbigarrayset(_unsafe, n, _kind, Pbigarray_unknown_layout) ->
- Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n))
- | p ->
- if size_int = 8 then p else simplif_primitive_32bits p
-
-(* Build switchers both for constants and blocks *)
-
-let transl_isout h arg dbg = tag_int (Cop(Ccmpa Clt, [h ; arg], dbg)) dbg
-
-(* Build an actual switch (ie jump table) *)
-
-let make_switch arg cases actions dbg =
- let extract_uconstant =
- function
- (* Constant integers loaded from a table should end in 1,
- so that Cload never produces untagged integers *)
- | Cconst_int (n, _), _dbg
- | Cconst_pointer (n, _), _dbg when (n land 1) = 1 ->
- Some (Cint (Nativeint.of_int n))
- | Cconst_natint (n, _), _dbg
- | Cconst_natpointer (n, _), _dbg
- when Nativeint.(to_int (logand n one) = 1) ->
- Some (Cint n)
- | Cconst_symbol (s,_), _dbg ->
- Some (Csymbol_address s)
- | _ -> None
- in
- let extract_affine ~cases ~const_actions =
- let length = Array.length cases in
- if length >= 2
- then begin
- match const_actions.(cases.(0)), const_actions.(cases.(1)) with
- | Cint v0, Cint v1 ->
- let slope = Nativeint.sub v1 v0 in
- let check i = function
- | Cint v -> v = Nativeint.(add (mul (of_int i) slope) v0)
- | _ -> false
- in
- if Misc.Stdlib.Array.for_alli
- (fun i idx -> check i const_actions.(idx)) cases
- then Some (v0, slope)
- else None
- | _, _ ->
- None
- end
- else None
- in
- let make_table_lookup ~cases ~const_actions arg dbg =
- let table = Compilenv.new_const_symbol () in
- Cmmgen_state.add_constant table (Const_table (Local,
- Array.to_list (Array.map (fun act ->
- const_actions.(act)) cases)));
- addr_array_ref (Cconst_symbol (table, dbg)) (tag_int arg dbg) dbg
- in
- let make_affine_computation ~offset ~slope arg dbg =
- (* In case the resulting integers are an affine function of the index, we
- don't emit a table, and just compute the result directly *)
- add_int
- (mul_int arg (natint_const_untagged dbg slope) dbg)
- (natint_const_untagged dbg offset)
- dbg
- in
- match Misc.Stdlib.Array.all_somes (Array.map extract_uconstant actions) with
- | None ->
- Cswitch (arg,cases,actions,dbg)
- | Some const_actions ->
- match extract_affine ~cases ~const_actions with
- | Some (offset, slope) ->
- make_affine_computation ~offset ~slope arg dbg
- | None -> make_table_lookup ~cases ~const_actions arg dbg
-
-module SArgBlocks =
-struct
- type primitive = operation
-
- let eqint = Ccmpi Ceq
- let neint = Ccmpi Cne
- let leint = Ccmpi Cle
- let ltint = Ccmpi Clt
- let geint = Ccmpi Cge
- let gtint = Ccmpi Cgt
-
- type act = expression
-
- (* CR mshinwell: GPR#2294 will fix the Debuginfo here *)
-
- let make_const i = Cconst_int (i, Debuginfo.none)
- let make_prim p args = Cop (p,args, Debuginfo.none)
- let make_offset arg n = add_const arg n Debuginfo.none
- let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none)
- let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none)
- let make_if cond ifso ifnot =
- Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot,
- Debuginfo.none)
- let make_switch loc arg cases actions =
- let dbg = Debuginfo.from_location loc in
- let actions = Array.map (fun expr -> expr, dbg) actions in
- make_switch arg cases actions dbg
- let bind arg body = bind "switcher" arg body
-
- let make_catch handler =
- match handler with
- | Cexit (i,[]) -> i,fun e -> e
- | _ ->
- let dbg = Debuginfo.none in
- let i = next_raise_count () in
-(*
- Printf.eprintf "SHARE CMM: %i\n" i ;
- Printcmm.expression Format.str_formatter handler ;
- Printf.eprintf "%s\n" (Format.flush_str_formatter ()) ;
-*)
- i,
- (fun body -> match body with
- | Cexit (j,_) ->
- if i=j then handler
- else body
- | _ -> ccatch (i,[],body,handler, dbg))
-
- let make_exit i = Cexit (i,[])
-
-end
-
-(* cmm store, as sharing as normally been detected in previous
- phases, we only share exits *)
-(* Some specific patterns can lead to switches where several cases
- point to the same action, but this action is not an exit (see GPR#1370).
- The addition of the index in the action array as context allows
- sharing them correctly without duplication. *)
-module StoreExpForSwitch =
- Switch.CtxStore
- (struct
- type t = expression
- type key = int option * int
- type context = int
- let make_key index expr =
- let continuation =
- match expr with
- | Cexit (i,[]) -> Some i
- | _ -> None
- in
- Some (continuation, index)
- let compare_key (cont, index) (cont', index') =
- match cont, cont' with
- | Some i, Some i' when i = i' -> 0
- | _, _ -> Stdlib.compare index index'
- end)
-
-(* For string switches, we can use a generic store *)
-module StoreExp =
- Switch.Store
- (struct
- type t = expression
- type key = int
- let make_key = function
- | Cexit (i,[]) -> Some i
- | _ -> None
- let compare_key = Stdlib.compare
- end)
-
-module SwitcherBlocks = Switch.Make(SArgBlocks)
-
-(* Int switcher, arg in [low..high],
- cases is list of individual cases, and is sorted by first component *)
-
-let transl_int_switch loc arg low high cases default = match cases with
-| [] -> assert false
-| _::_ ->
- let store = StoreExp.mk_store () in
- assert (store.Switch.act_store () default = 0) ;
- let cases =
- List.map
- (fun (i,act) -> i,store.Switch.act_store () act)
- cases in
- let rec inters plow phigh pact = function
- | [] ->
- if phigh = high then [plow,phigh,pact]
- else [(plow,phigh,pact); (phigh+1,high,0) ]
- | (i,act)::rem ->
- if i = phigh+1 then
- if pact = act then
- inters plow i pact rem
- else
- (plow,phigh,pact)::inters i i act rem
- else (* insert default *)
- if pact = 0 then
- if act = 0 then
- inters plow i 0 rem
- else
- (plow,i-1,pact)::
- inters i i act rem
- else (* pact <> 0 *)
- (plow,phigh,pact)::
- begin
- if act = 0 then inters (phigh+1) i 0 rem
- else (phigh+1,i-1,0)::inters i i act rem
- end in
- let inters = match cases with
- | [] -> assert false
- | (k0,act0)::rem ->
- if k0 = low then inters k0 k0 act0 rem
- else inters low (k0-1) 0 cases in
- bind "switcher" arg
- (fun a ->
- SwitcherBlocks.zyva
- loc
- (low,high)
- a
- (Array.of_list inters) store)
+(* Returns the unboxed representation of a boxed float or integer.
+ For Pint32 on 64-bit archs, the high 32 bits of the result are undefined. *)
+let unbox_number dbg bn arg =
+ match bn with
+ | Boxed_float dbg ->
+ unbox_float dbg arg
+ | Boxed_integer (Pint32, _) ->
+ low_32 dbg (unbox_int dbg Pint32 arg)
+ | Boxed_integer (bi, _) ->
+ unbox_int dbg bi arg
(* Auxiliary functions for optimizing "let" of boxed numbers (floats and
| Boxed of boxed_number * bool (* true: boxed form available at no cost *)
| No_result (* expression never returns a result *)
-let unboxed_number_kind_of_unbox dbg = function
- | Same_as_ocaml_repr -> No_unboxing
- | Unboxed_float -> Boxed (Boxed_float dbg, false)
- | Unboxed_integer bi -> Boxed (Boxed_integer (bi, dbg), false)
- | Untagged_int -> No_unboxing
-
-let rec is_unboxed_number ~strict env e =
- (* Given unboxed_number_kind from two branches of the code, returns the
- resulting unboxed_number_kind.
-
- If [strict=false], one knows that the type of the expression
- is an unboxable number, and we decide to return an unboxed value
- if this indeed eliminates at least one allocation.
-
- If [strict=true], we need to ensure that all possible branches
- return an unboxable number (of the same kind). This could not
- be the case in presence of GADTs.
- *)
- let join k1 e =
- match k1, is_unboxed_number ~strict env e with
- | Boxed (b1, c1), Boxed (b2, c2) when equal_boxed_number b1 b2 ->
- Boxed (b1, c1 && c2)
- | No_result, k | k, No_result ->
- k (* if a branch never returns, it is safe to unbox it *)
- | No_unboxing, k | k, No_unboxing when not strict ->
- k
- | _, _ -> No_unboxing
- in
- match e with
- | Uvar id ->
- begin match is_unboxed_id id env with
- | None -> No_unboxing
- | Some (_, bn) -> Boxed (bn, false)
- end
-
- (* CR mshinwell: Changes to [Clambda] will provide the [Debuginfo] here *)
- | Uconst(Uconst_ref(_, Some (Uconst_float _))) ->
- let dbg = Debuginfo.none in
- Boxed (Boxed_float dbg, true)
- | Uconst(Uconst_ref(_, Some (Uconst_int32 _))) ->
- let dbg = Debuginfo.none in
- Boxed (Boxed_integer (Pint32, dbg), true)
- | Uconst(Uconst_ref(_, Some (Uconst_int64 _))) ->
- let dbg = Debuginfo.none in
- Boxed (Boxed_integer (Pint64, dbg), true)
- | Uconst(Uconst_ref(_, Some (Uconst_nativeint _))) ->
- let dbg = Debuginfo.none in
- Boxed (Boxed_integer (Pnativeint, dbg), true)
- | Uprim(p, _, dbg) ->
- begin match simplif_primitive p with
- | Pccall p -> unboxed_number_kind_of_unbox dbg p.prim_native_repr_res
- | Pfloatfield _
- | Pfloatofint
- | Pnegfloat
- | Pabsfloat
- | Paddfloat
- | Psubfloat
- | Pmulfloat
- | Pdivfloat
- | Parrayrefu Pfloatarray
- | Parrayrefs Pfloatarray -> Boxed (Boxed_float dbg, false)
- | Pbintofint bi
- | Pcvtbint(_, bi)
- | Pnegbint bi
- | Paddbint bi
- | Psubbint bi
- | Pmulbint bi
- | Pdivbint {size=bi}
- | Pmodbint {size=bi}
- | Pandbint bi
- | Porbint bi
- | Pxorbint bi
- | Plslbint bi
- | Plsrbint bi
- | Pasrbint bi
- | Pbbswap bi -> Boxed (Boxed_integer (bi, dbg), false)
- | Pbigarrayref(_, _, (Pbigarray_float32 | Pbigarray_float64), _) ->
- Boxed (Boxed_float dbg, false)
- | Pbigarrayref(_, _, Pbigarray_int32, _) ->
- Boxed (Boxed_integer (Pint32, dbg), false)
- | Pbigarrayref(_, _, Pbigarray_int64, _) ->
- Boxed (Boxed_integer (Pint64, dbg), false)
- | Pbigarrayref(_, _, Pbigarray_native_int,_) ->
- Boxed (Boxed_integer (Pnativeint, dbg), false)
- | Pstring_load(Thirty_two,_)
- | Pbytes_load(Thirty_two,_) ->
- Boxed (Boxed_integer (Pint32, dbg), false)
- | Pstring_load(Sixty_four,_)
- | Pbytes_load(Sixty_four,_) ->
- Boxed (Boxed_integer (Pint64, dbg), false)
- | Pbigstring_load(Thirty_two,_) ->
- Boxed (Boxed_integer (Pint32, dbg), false)
- | Pbigstring_load(Sixty_four,_) ->
- Boxed (Boxed_integer (Pint64, dbg), false)
- | Praise _ -> No_result
- | _ -> No_unboxing
- end
- | Ulet (_, _, _, _, e) | Uletrec (_, e) | Usequence (_, e) ->
- is_unboxed_number ~strict env e
- | Uswitch (_, switch, _dbg) ->
- let k = Array.fold_left join No_result switch.us_actions_consts in
- Array.fold_left join k switch.us_actions_blocks
- | Ustringswitch (_, actions, default_opt) ->
- let k = List.fold_left (fun k (_, e) -> join k e) No_result actions in
- begin match default_opt with
- None -> k
- | Some default -> join k default
- end
- | Ustaticfail _ -> No_result
- | Uifthenelse (_, e1, e2) | Ucatch (_, _, e1, e2) | Utrywith (e1, _, e2) ->
- join (is_unboxed_number ~strict env e1) e2
- | _ -> No_unboxing
+(* Given unboxed_number_kind from two branches of the code, returns the
+ resulting unboxed_number_kind.
-(* Helper for compilation of initialization and assignment operations *)
+ If [strict=false], one knows that the type of the expression
+ is an unboxable number, and we decide to return an unboxed value
+ if this indeed eliminates at least one allocation.
-type assignment_kind = Caml_modify | Caml_initialize | Simple
-
-let assignment_kind ptr init =
- match init, ptr with
- | Assignment, Pointer -> Caml_modify
- | Heap_initialization, Pointer -> Caml_initialize
- | Assignment, Immediate
- | Heap_initialization, Immediate
- | Root_initialization, (Immediate | Pointer) -> Simple
+ If [strict=true], we need to ensure that all possible branches
+ return an unboxable number (of the same kind). This could not
+ be the case in presence of GADTs.
+*)
+let join_unboxed_number_kind ~strict k1 k2 =
+ match k1, k2 with
+ | Boxed (b1, c1), Boxed (b2, c2) when equal_boxed_number b1 b2 ->
+ Boxed (b1, c1 && c2)
+ | No_result, k | k, No_result ->
+ k (* if a branch never returns, it is safe to unbox it *)
+ | No_unboxing, k | k, No_unboxing when not strict ->
+ k
+ | _, _ -> No_unboxing
+
+let is_unboxed_number_cmm ~strict cmm =
+ let r = ref No_result in
+ let notify k =
+ r := join_unboxed_number_kind ~strict !r k
+ in
+ let rec aux = function
+ | Cop(Calloc, [Cblockheader (hdr, _); _], dbg)
+ when Nativeint.equal hdr float_header ->
+ notify (Boxed (Boxed_float dbg, false))
+ | Cop(Calloc, [Cblockheader (hdr, _); Cconst_symbol (ops, _); _], dbg) ->
+ if Nativeint.equal hdr boxedintnat_header
+ && String.equal ops caml_nativeint_ops
+ then
+ notify (Boxed (Boxed_integer (Pnativeint, dbg), false))
+ else
+ if Nativeint.equal hdr boxedint32_header
+ && String.equal ops caml_int32_ops
+ then
+ notify (Boxed (Boxed_integer (Pint32, dbg), false))
+ else
+ if Nativeint.equal hdr boxedint64_header
+ && String.equal ops caml_int64_ops
+ then
+ notify (Boxed (Boxed_integer (Pint64, dbg), false))
+ else
+ notify No_unboxing
+ | Cconst_symbol (s, _) ->
+ begin match Cmmgen_state.structured_constant_of_sym s with
+ | Some (Uconst_float _) ->
+ notify (Boxed (Boxed_float Debuginfo.none, true))
+ | Some (Uconst_nativeint _) ->
+ notify (Boxed (Boxed_integer (Pnativeint, Debuginfo.none), true))
+ | Some (Uconst_int32 _) ->
+ notify (Boxed (Boxed_integer (Pint32, Debuginfo.none), true))
+ | Some (Uconst_int64 _) ->
+ notify (Boxed (Boxed_integer (Pint64, Debuginfo.none), true))
+ | _ ->
+ notify No_unboxing
+ end
+ | l ->
+ if not (Cmm.iter_shallow_tail aux l) then
+ notify No_unboxing
+ in
+ aux cmm;
+ !r
(* Translate an expression *)
-let strmatch_compile =
- let module S =
- Strmatch.Make
- (struct
- let string_block_length ptr = get_size ptr Debuginfo.none
- let transl_switch = transl_int_switch
- end) in
- S.compile
-
let rec transl env e =
match e with
Uvar id ->
int_const dbg f.arity ::
transl_fundecls (pos + 3) rem
else
- Cconst_symbol (curry_function f.arity, dbg) ::
+ Cconst_symbol (curry_function_sym f.arity, dbg) ::
int_const dbg f.arity ::
Cconst_symbol (f.label, dbg) ::
transl_fundecls (pos + 4) rem
(* produces a valid Caml value, pointing just after an infix header *)
let ptr = transl env arg in
let dbg = Debuginfo.none in
- if offset = 0
- then ptr
- else Cop(Caddv, [ptr; Cconst_int(offset * size_addr, dbg)], dbg)
+ ptr_offset ptr offset dbg
| Udirect_apply(lbl, args, dbg) ->
- Cop(Capply typ_val,
- Cconst_symbol (lbl, dbg) :: List.map (transl env) args,
- dbg)
- | Ugeneric_apply(clos, [arg], dbg) ->
- bind "fun" (transl env clos) (fun clos ->
- Cop(Capply typ_val,
- [get_field env clos 0 dbg; transl env arg; clos],
- dbg))
+ let args = List.map (transl env) args in
+ direct_apply lbl args dbg
| Ugeneric_apply(clos, args, dbg) ->
- let arity = List.length args in
- let cargs = Cconst_symbol(apply_function arity, dbg) ::
- List.map (transl env) (args @ [clos]) in
- Cop(Capply typ_val, cargs, dbg)
+ let clos = transl env clos in
+ let args = List.map (transl env) args in
+ generic_apply (mut_from_env env clos) clos args dbg
| Usend(kind, met, obj, args, dbg) ->
- let call_met obj args clos =
- if args = [] then
- Cop(Capply typ_val,
- [get_field env clos 0 dbg; obj; clos], dbg)
- else
- let arity = List.length args + 1 in
- let cargs = Cconst_symbol(apply_function arity, dbg) :: obj ::
- (List.map (transl env) args) @ [clos] in
- Cop(Capply typ_val, cargs, dbg)
- in
- bind "obj" (transl env obj) (fun obj ->
- match kind, args with
- Self, _ ->
- bind "met" (lookup_label obj (transl env met) dbg)
- (call_met obj args)
- | Cached, cache :: pos :: args ->
- call_cached_method obj
- (transl env met) (transl env cache) (transl env pos)
- (List.map (transl env) args) dbg
- | _ ->
- bind "met" (lookup_tag obj (transl env met) dbg)
- (call_met obj args))
+ let met = transl env met in
+ let obj = transl env obj in
+ let args = List.map (transl env) args in
+ send kind met obj args dbg
| Ulet(str, kind, id, exp, body) ->
transl_let env str kind id exp body
| Uphantom_let (var, defining_expr, body) ->
| Pbigarray_int32 -> box_int dbg Pint32 elt
| Pbigarray_int64 -> box_int dbg Pint64 elt
| Pbigarray_native_int -> box_int dbg Pnativeint elt
- | Pbigarray_caml_int -> force_tag_int elt dbg
- | _ -> tag_int elt dbg
+ | Pbigarray_caml_int -> tag_int elt dbg
+ | Pbigarray_sint8 | Pbigarray_uint8
+ | Pbigarray_sint16 | Pbigarray_uint16 -> tag_int elt dbg
+ | Pbigarray_unknown -> assert false
end
| (Pbigarrayset(unsafe, _num_dims, elt_kind, layout), arg1 :: argl) ->
let (argidx, argnewval) = split_last argl in
| Pbigarray_int64 -> transl_unbox_int dbg env Pint64 argnewval
| Pbigarray_native_int ->
transl_unbox_int dbg env Pnativeint argnewval
- | _ -> untag_int (transl env argnewval) dbg)
+ | Pbigarray_caml_int ->
+ untag_int (transl env argnewval) dbg
+ | Pbigarray_sint8 | Pbigarray_uint8
+ | Pbigarray_sint16 | Pbigarray_uint16 ->
+ ignore_high_bit_int (untag_int (transl env argnewval) dbg)
+ | Pbigarray_unknown -> assert false)
dbg)
| (Pbigarraydim(n), [b]) ->
let dim_ofs = 4 + n in
let dbg = Debuginfo.none in
bind "switch" (transl env arg)
(fun arg ->
- strmatch_compile dbg arg (Misc.may_map (transl env) d)
+ strmatch_compile dbg arg (Option.map (transl env) d)
(List.map (fun (s,act) -> s,transl env act) sw))
| Ustaticfail (nfail, args) ->
- Cexit (nfail, List.map (transl env) args)
+ let cargs = List.map (transl env) args in
+ notify_catch nfail env cargs;
+ Cexit (nfail, cargs)
| Ucatch(nfail, [], body, handler) ->
let dbg = Debuginfo.none in
make_catch nfail (transl env body) (transl env handler) dbg
| Ucatch(nfail, ids, body, handler) ->
let dbg = Debuginfo.none in
- (* CR-someday mshinwell: consider how we can do better than
- [typ_val] when appropriate. *)
- let ids_with_types =
- List.map (fun (i, _) -> (i, Cmm.typ_val)) ids in
- ccatch(nfail, ids_with_types, transl env body, transl env handler, dbg)
+ transl_catch env nfail ids body handler dbg
| Utrywith(body, exn, handler) ->
let dbg = Debuginfo.none in
Ctrywith(transl env body, exn, transl env handler, dbg)
dbg))))
| Uassign(id, exp) ->
let dbg = Debuginfo.none in
+ let cexp = transl env exp in
begin match is_unboxed_id id env with
| None ->
- return_unit dbg (Cassign(id, transl env exp))
+ return_unit dbg (Cassign(id, cexp))
| Some (unboxed_id, bn) ->
- return_unit dbg (Cassign(unboxed_id,
- transl_unbox_number dbg env bn exp))
+ return_unit dbg (Cassign(unboxed_id, unbox_number dbg bn cexp))
end
| Uunreachable ->
let dbg = Debuginfo.none in
Cop(Cload (Word_int, Mutable), [Cconst_int (0, dbg)], dbg)
+and transl_catch env nfail ids body handler dbg =
+ let ids = List.map (fun (id, kind) -> (id, kind, ref No_result)) ids in
+ (* Translate the body, and while doing so, collect the "unboxing type" for
+ each argument. *)
+ let report args =
+ List.iter2
+ (fun (_id, kind, u) c ->
+ let strict =
+ match kind with
+ | Pfloatval | Pboxedintval _ -> false
+ | Pintval | Pgenval -> true
+ in
+ u := join_unboxed_number_kind ~strict !u
+ (is_unboxed_number_cmm ~strict c)
+ )
+ ids args
+ in
+ let env_body = add_notify_catch nfail report env in
+ let body = transl env_body body in
+ let typ_of_bn = function
+ | Boxed_float _ -> Cmm.typ_float
+ | Boxed_integer (Pint64, _) when size_int = 4 -> [|Int;Int|]
+ | Boxed_integer _ -> Cmm.typ_int
+ in
+ let new_env, rewrite, ids =
+ List.fold_right
+ (fun (id, _kind, u) (env, rewrite, ids) ->
+ match !u with
+ | No_unboxing | Boxed (_, true) | No_result ->
+ env,
+ (fun x -> x) :: rewrite,
+ (id, Cmm.typ_val) :: ids
+ | Boxed (bn, false) ->
+ let unboxed_id = V.create_local (VP.name id) in
+ add_unboxed_id (VP.var id) unboxed_id bn env,
+ (unbox_number Debuginfo.none bn) :: rewrite,
+ (VP.create unboxed_id, typ_of_bn bn) :: ids
+ )
+ ids (env, [], [])
+ in
+ if env == new_env then
+ (* No unboxing *)
+ ccatch (nfail, ids, body, transl env handler, dbg)
+ else
+ (* allocate new "nfail" to catch errors more easily *)
+ let new_nfail = next_raise_count () in
+ let body =
+ (* Rewrite the body to unbox the call sites *)
+ let rec aux e =
+ match Cmm.map_shallow aux e with
+ | Cexit (n, el) when n = nfail ->
+ Cexit (new_nfail, List.map2 (fun f e -> f e) rewrite el)
+ | c -> c
+ in
+ aux body
+ in
+ ccatch (new_nfail, ids, body, transl new_env handler, dbg)
+
and transl_make_array dbg env kind args =
match kind with
| Pgenarray ->
get_field env (transl env arg) n dbg
| Pfloatfield n ->
let ptr = transl env arg in
- box_float dbg (
- Cop(Cload (Double_u, Mutable),
- [if n = 0
- then ptr
- else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)],
- dbg))
+ box_float dbg (floatfield n ptr dbg)
| Pint_as_pointer ->
- Cop(Caddi, [transl env arg; Cconst_int (-1, dbg)], dbg)
- (* always a pointer outside the heap *)
+ int_as_pointer (transl env arg) dbg
(* Exceptions *)
- | Praise _ when not (!Clflags.debug) ->
- Cop(Craise Cmm.Raise_notrace, [transl env arg], dbg)
- | Praise Lambda.Raise_notrace ->
- Cop(Craise Cmm.Raise_notrace, [transl env arg], dbg)
- | Praise Lambda.Raise_reraise ->
- Cop(Craise Cmm.Raise_withtrace, [transl env arg], dbg)
- | Praise Lambda.Raise_regular ->
- raise_regular dbg (transl env arg)
+ | Praise rkind ->
+ raise_prim rkind (transl env arg) dbg
(* Integer operations *)
| Pnegint ->
- Cop(Csubi, [Cconst_int (2, dbg); transl env arg], dbg)
+ negint (transl env arg) dbg
| Poffsetint n ->
- if no_overflow_lsl n 1 then
- add_const (transl env arg) (n lsl 1) dbg
- else
- transl_prim_2 env Paddint arg (Uconst (Uconst_int n)) dbg
+ offsetint n (transl env arg) dbg
| Poffsetref n ->
- return_unit dbg
- (bind "ref" (transl env arg) (fun arg ->
- Cop(Cstore (Word_int, Assignment),
- [arg;
- add_const (Cop(Cload (Word_int, Mutable), [arg], dbg))
- (n lsl 1) dbg],
- dbg)))
+ offsetref n (transl env arg) dbg
(* Floating-point operations *)
| Pfloatofint ->
box_float dbg (Cop(Cfloatofint, [untag_int(transl env arg) dbg], dbg))
tag_int(string_length (transl env arg) dbg) dbg
(* Array operations *)
| Parraylength kind ->
- let hdr = get_header_without_profinfo (transl env arg) dbg in
- begin match kind with
- Pgenarray ->
- let len =
- if wordsize_shift = numfloat_shift then
- Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg)
- else
- bind "header" hdr (fun hdr ->
- Cifthenelse(is_addr_array_hdr hdr dbg,
- dbg,
- Cop(Clsr,
- [hdr; Cconst_int (wordsize_shift, dbg)], dbg),
- dbg,
- Cop(Clsr,
- [hdr; Cconst_int (numfloat_shift, dbg)], dbg),
- dbg))
- in
- Cop(Cor, [len; Cconst_int (1, dbg)], dbg)
- | Paddrarray | Pintarray ->
- Cop(Cor, [addr_array_length hdr dbg; Cconst_int (1, dbg)], dbg)
- | Pfloatarray ->
- Cop(Cor, [float_array_length hdr dbg; Cconst_int (1, dbg)], dbg)
- end
+ arraylength kind (transl env arg) dbg
(* Boolean operations *)
| Pnot ->
transl_if env Then_false_else_true
| Pbintofint bi ->
box_int dbg bi (untag_int (transl env arg) dbg)
| Pintofbint bi ->
- force_tag_int (transl_unbox_int dbg env bi arg) dbg
+ tag_int (transl_unbox_int dbg env bi arg) dbg
| Pcvtbint(bi1, bi2) ->
box_int dbg bi2 (transl_unbox_int dbg env bi1 arg)
| Pnegbint bi ->
(Cop(Csubi, [Cconst_int (0, dbg); transl_unbox_int dbg env bi arg],
dbg))
| Pbbswap bi ->
- let prim = match bi with
- | Pnativeint -> "nativeint"
- | Pint32 -> "int32"
- | Pint64 -> "int64" in
- box_int dbg bi (Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim,
- typ_int, false, None),
- [transl_unbox_int dbg env bi arg],
- dbg))
+ box_int dbg bi (bbswap bi (transl_unbox_int dbg env bi arg) dbg)
| Pbswap16 ->
- tag_int (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None),
- [untag_int (transl env arg) dbg],
- dbg))
- dbg
+ tag_int (bswap16 (ignore_high_bit_int (untag_int
+ (transl env arg) dbg)) dbg) dbg
| (Pfield_computed | Psequand | Psequor
| Paddint | Psubint | Pmulint | Pandint
| Porint | Pxorint | Plslint | Plsrint | Pasrint
| Pfield_computed ->
addr_array_ref (transl env arg1) (transl env arg2) dbg
| Psetfield(n, ptr, init) ->
- begin match assignment_kind ptr init with
- | Caml_modify ->
- return_unit dbg (Cop(Cextcall("caml_modify", typ_void, false, None),
- [field_address (transl env arg1) n dbg;
- transl env arg2],
- dbg))
- | Caml_initialize ->
- return_unit dbg (Cop(Cextcall("caml_initialize", typ_void, false, None),
- [field_address (transl env arg1) n dbg;
- transl env arg2],
- dbg))
- | Simple ->
- return_unit dbg
- (set_field (transl env arg1) n (transl env arg2) init dbg)
- end
+ setfield n ptr init (transl env arg1) (transl env arg2) dbg
| Psetfloatfield (n, init) ->
let ptr = transl env arg1 in
- return_unit dbg (
- Cop(Cstore (Double_u, init),
- [if n = 0 then ptr
- else
- Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg);
- transl_unbox_float dbg env arg2], dbg))
+ let float_val = transl_unbox_float dbg env arg2 in
+ setfloatfield n init ptr float_val dbg
(* Boolean operations *)
| Psequand ->
dbg' (Cconst_pointer (1, dbg))
(* Integer operations *)
| Paddint ->
- decr_int(add_int (transl env arg1) (transl env arg2) dbg) dbg
+ add_int_caml (transl env arg1) (transl env arg2) dbg
| Psubint ->
- incr_int(sub_int (transl env arg1) (transl env arg2) dbg) dbg
+ sub_int_caml (transl env arg1) (transl env arg2) dbg
| Pmulint ->
- begin
- (* decrementing the non-constant part helps when the multiplication is
- followed by an addition;
- for example, using this trick compiles (100 * a + 7) into
- (+ ( * a 100) -85)
- rather than
- (+ ( * 200 (>>s a 1)) 15)
- *)
- match transl env arg1, transl env arg2 with
- | Cconst_int _ as c1, c2 ->
- incr_int (mul_int (untag_int c1 dbg) (decr_int c2 dbg) dbg) dbg
- | c1, c2 ->
- incr_int (mul_int (decr_int c1 dbg) (untag_int c2 dbg) dbg) dbg
- end
+ mul_int_caml (transl env arg1) (transl env arg2) dbg
| Pdivint is_safe ->
- tag_int(div_int (untag_int(transl env arg1) dbg)
- (untag_int(transl env arg2) dbg) is_safe dbg) dbg
+ div_int_caml is_safe (transl env arg1) (transl env arg2) dbg
| Pmodint is_safe ->
- tag_int(mod_int (untag_int(transl env arg1) dbg)
- (untag_int(transl env arg2) dbg) is_safe dbg) dbg
+ mod_int_caml is_safe (transl env arg1) (transl env arg2) dbg
| Pandint ->
- Cop(Cand, [transl env arg1; transl env arg2], dbg)
+ and_int_caml (transl env arg1) (transl env arg2) dbg
| Porint ->
- Cop(Cor, [transl env arg1; transl env arg2], dbg)
+ or_int_caml (transl env arg1) (transl env arg2) dbg
| Pxorint ->
- Cop(Cor, [Cop(Cxor, [ignore_low_bit_int(transl env arg1);
- ignore_low_bit_int(transl env arg2)], dbg);
- Cconst_int (1, dbg)], dbg)
+ xor_int_caml (transl env arg1) (transl env arg2) dbg
| Plslint ->
- incr_int(lsl_int (decr_int(transl env arg1) dbg)
- (untag_int(transl env arg2) dbg) dbg) dbg
+ lsl_int_caml (transl env arg1) (transl env arg2) dbg
| Plsrint ->
- Cop(Cor, [lsr_int (transl env arg1) (untag_int(transl env arg2) dbg) dbg;
- Cconst_int (1, dbg)], dbg)
+ lsr_int_caml (transl env arg1) (transl env arg2) dbg
| Pasrint ->
- Cop(Cor, [asr_int (transl env arg1) (untag_int(transl env arg2) dbg) dbg;
- Cconst_int (1, dbg)], dbg)
+ asr_int_caml (transl env arg1) (transl env arg2) dbg
| Pintcomp cmp ->
- tag_int(Cop(Ccmpi(transl_int_comparison cmp),
- [transl env arg1; transl env arg2], dbg)) dbg
+ int_comp_caml cmp (transl env arg1) (transl env arg2) dbg
| Pisout ->
transl_isout (transl env arg1) (transl env arg2) dbg
(* Float operations *)
transl_unbox_float dbg env arg2],
dbg))
| Pfloatcomp cmp ->
- tag_int(Cop(Ccmpf(transl_float_comparison cmp),
+ tag_int(Cop(Ccmpf cmp,
[transl_unbox_float dbg env arg1;
transl_unbox_float dbg env arg2],
dbg)) dbg
(* String operations *)
| Pstringrefu | Pbytesrefu ->
- tag_int(Cop(Cload (Byte_unsigned, Mutable),
- [add_int (transl env arg1) (untag_int(transl env arg2) dbg)
- dbg],
- dbg)) dbg
+ stringref_unsafe (transl env arg1) (transl env arg2) dbg
| Pstringrefs | Pbytesrefs ->
- tag_int
- (bind "str" (transl env arg1) (fun str ->
- bind "index" (untag_int (transl env arg2) dbg) (fun idx ->
- Csequence(
- make_checkbound dbg [string_length str dbg; idx],
- Cop(Cload (Byte_unsigned, Mutable),
- [add_int str idx dbg], dbg))))) dbg
-
+ stringref_safe (transl env arg1) (transl env arg2) dbg
| Pstring_load(size, unsafe) | Pbytes_load(size, unsafe) ->
- box_sized size dbg
- (bind "str" (transl env arg1) (fun str ->
- bind "index" (untag_int (transl env arg2) dbg) (fun idx ->
- check_bound unsafe size dbg
- (string_length str dbg)
- idx (unaligned_load size str idx dbg))))
-
+ string_load size unsafe (transl env arg1) (transl env arg2) dbg
| Pbigstring_load(size, unsafe) ->
- box_sized size dbg
- (bind "ba" (transl env arg1) (fun ba ->
- bind "index" (untag_int (transl env arg2) dbg) (fun idx ->
- bind "ba_data"
- (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
- (fun ba_data ->
- check_bound unsafe size dbg
- (bigstring_length ba dbg)
- idx
- (unaligned_load size ba_data idx dbg)))))
+ bigstring_load size unsafe (transl env arg1) (transl env arg2) dbg
(* Array operations *)
| Parrayrefu kind ->
- begin match kind with
- Pgenarray ->
- bind "arr" (transl env arg1) (fun arr ->
- bind "index" (transl env arg2) (fun idx ->
- Cifthenelse(is_addr_array_ptr arr dbg,
- dbg,
- addr_array_ref arr idx dbg,
- dbg,
- float_array_ref dbg arr idx,
- dbg)))
- | Paddrarray ->
- addr_array_ref (transl env arg1) (transl env arg2) dbg
- | Pintarray ->
- (* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *)
- int_array_ref (transl env arg1) (transl env arg2) dbg
- | Pfloatarray ->
- float_array_ref dbg (transl env arg1) (transl env arg2)
- end
+ arrayref_unsafe kind (transl env arg1) (transl env arg2) dbg
| Parrayrefs kind ->
- begin match kind with
- | Pgenarray ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
- if wordsize_shift = numfloat_shift then
- Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx],
- Cifthenelse(is_addr_array_hdr hdr dbg,
- dbg,
- addr_array_ref arr idx dbg,
- dbg,
- float_array_ref dbg arr idx,
- dbg))
- else
- Cifthenelse(is_addr_array_hdr hdr dbg,
- dbg,
- Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx],
- addr_array_ref arr idx dbg),
- dbg,
- Csequence(make_checkbound dbg [float_array_length hdr dbg; idx],
- float_array_ref dbg arr idx),
- dbg))))
- | Paddrarray ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- Csequence(make_checkbound dbg [
- addr_array_length(get_header_without_profinfo arr dbg) dbg; idx],
- addr_array_ref arr idx dbg)))
- | Pintarray ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- Csequence(make_checkbound dbg [
- addr_array_length(get_header_without_profinfo arr dbg) dbg; idx],
- int_array_ref arr idx dbg)))
- | Pfloatarray ->
- box_float dbg (
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- Csequence(make_checkbound dbg
- [float_array_length(get_header_without_profinfo arr dbg) dbg;
- idx],
- unboxed_float_array_ref arr idx dbg))))
- end
+ arrayref_safe kind (transl env arg1) (transl env arg2) dbg
(* Boxed integers *)
| Paddbint bi ->
box_int dbg bi (Cop(Caddi,
- [transl_unbox_int dbg env bi arg1;
- transl_unbox_int dbg env bi arg2], dbg))
+ [transl_unbox_int_low dbg env bi arg1;
+ transl_unbox_int_low dbg env bi arg2], dbg))
| Psubbint bi ->
box_int dbg bi (Cop(Csubi,
- [transl_unbox_int dbg env bi arg1;
- transl_unbox_int dbg env bi arg2], dbg))
+ [transl_unbox_int_low dbg env bi arg1;
+ transl_unbox_int_low dbg env bi arg2], dbg))
| Pmulbint bi ->
box_int dbg bi (Cop(Cmuli,
- [transl_unbox_int dbg env bi arg1;
- transl_unbox_int dbg env bi arg2], dbg))
+ [transl_unbox_int_low dbg env bi arg1;
+ transl_unbox_int_low dbg env bi arg2], dbg))
| Pdivbint { size = bi; is_safe } ->
box_int dbg bi (safe_div_bi is_safe
(transl_unbox_int dbg env bi arg1)
bi dbg)
| Pandbint bi ->
box_int dbg bi (Cop(Cand,
- [transl_unbox_int dbg env bi arg1;
- transl_unbox_int dbg env bi arg2], dbg))
+ [transl_unbox_int_low dbg env bi arg1;
+ transl_unbox_int_low dbg env bi arg2], dbg))
| Porbint bi ->
box_int dbg bi (Cop(Cor,
- [transl_unbox_int dbg env bi arg1;
- transl_unbox_int dbg env bi arg2], dbg))
+ [transl_unbox_int_low dbg env bi arg1;
+ transl_unbox_int_low dbg env bi arg2], dbg))
| Pxorbint bi ->
box_int dbg bi (Cop(Cxor,
- [transl_unbox_int dbg env bi arg1;
- transl_unbox_int dbg env bi arg2], dbg))
+ [transl_unbox_int_low dbg env bi arg1;
+ transl_unbox_int_low dbg env bi arg2], dbg))
| Plslbint bi ->
box_int dbg bi (Cop(Clsl,
- [transl_unbox_int dbg env bi arg1;
+ [transl_unbox_int_low dbg env bi arg1;
untag_int(transl env arg2) dbg], dbg))
| Plsrbint bi ->
box_int dbg bi (Cop(Clsr,
[transl_unbox_int dbg env bi arg1;
untag_int(transl env arg2) dbg], dbg))
| Pbintcomp(bi, cmp) ->
- tag_int (Cop(Ccmpi(transl_int_comparison cmp),
+ tag_int (Cop(Ccmpi cmp,
[transl_unbox_int dbg env bi arg1;
transl_unbox_int dbg env bi arg2], dbg)) dbg
| Pnot | Pnegint | Pintoffloat | Pfloatofint | Pnegfloat
match p with
(* Heap operations *)
| Psetfield_computed(ptr, init) ->
- begin match assignment_kind ptr init with
- | Caml_modify ->
- return_unit dbg (
- addr_array_set (transl env arg1) (transl env arg2) (transl env arg3)
- dbg)
- | Caml_initialize ->
- return_unit dbg (
- addr_array_initialize (transl env arg1) (transl env arg2)
- (transl env arg3) dbg)
- | Simple ->
- return_unit dbg (
- int_array_set (transl env arg1) (transl env arg2) (transl env arg3)
- dbg)
- end
+ setfield_computed ptr init
+ (transl env arg1) (transl env arg2) (transl env arg3) dbg
(* String operations *)
| Pbytessetu ->
- return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (transl env arg1)
- (untag_int(transl env arg2) dbg)
- dbg;
- untag_int(transl env arg3) dbg], dbg))
+ bytesset_unsafe
+ (transl env arg1) (transl env arg2) (transl env arg3) dbg
| Pbytessets ->
- return_unit dbg
- (bind "str" (transl env arg1) (fun str ->
- bind "index" (untag_int (transl env arg2) dbg) (fun idx ->
- Csequence(
- make_checkbound dbg [string_length str dbg; idx],
- Cop(Cstore (Byte_unsigned, Assignment),
- [add_int str idx dbg; untag_int(transl env arg3) dbg],
- dbg)))))
+ bytesset_safe
+ (transl env arg1) (transl env arg2) (transl env arg3) dbg
(* Array operations *)
| Parraysetu kind ->
- return_unit dbg (begin match kind with
- Pgenarray ->
- bind "newval" (transl env arg3) (fun newval ->
- bind "index" (transl env arg2) (fun index ->
- bind "arr" (transl env arg1) (fun arr ->
- Cifthenelse(is_addr_array_ptr arr dbg,
- dbg,
- addr_array_set arr index newval dbg,
- dbg,
- float_array_set arr index (unbox_float dbg newval)
- dbg,
- dbg))))
- | Paddrarray ->
- addr_array_set (transl env arg1) (transl env arg2) (transl env arg3)
- dbg
- | Pintarray ->
- int_array_set (transl env arg1) (transl env arg2) (transl env arg3)
- dbg
- | Pfloatarray ->
- float_array_set (transl env arg1) (transl env arg2)
- (transl_unbox_float dbg env arg3)
- dbg
- end)
+ let newval =
+ match kind with
+ | Pfloatarray -> transl_unbox_float dbg env arg3
+ | _ -> transl env arg3
+ in
+ arrayset_unsafe kind (transl env arg1) (transl env arg2) newval dbg
| Parraysets kind ->
- return_unit dbg (begin match kind with
- | Pgenarray ->
- bind "newval" (transl env arg3) (fun newval ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
- if wordsize_shift = numfloat_shift then
- Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx],
- Cifthenelse(is_addr_array_hdr hdr dbg,
- dbg,
- addr_array_set arr idx newval dbg,
- dbg,
- float_array_set arr idx
- (unbox_float dbg newval)
- dbg,
- dbg))
- else
- Cifthenelse(is_addr_array_hdr hdr dbg,
- dbg,
- Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx],
- addr_array_set arr idx newval dbg),
- dbg,
- Csequence(make_checkbound dbg [float_array_length hdr dbg; idx],
- float_array_set arr idx
- (unbox_float dbg newval) dbg),
- dbg)))))
- | Paddrarray ->
- bind "newval" (transl env arg3) (fun newval ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- Csequence(make_checkbound dbg [
- addr_array_length(get_header_without_profinfo arr dbg) dbg; idx],
- addr_array_set arr idx newval dbg))))
- | Pintarray ->
- bind "newval" (transl env arg3) (fun newval ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- Csequence(make_checkbound dbg [
- addr_array_length(get_header_without_profinfo arr dbg) dbg; idx],
- int_array_set arr idx newval dbg))))
- | Pfloatarray ->
- bind_load "newval" (transl_unbox_float dbg env arg3) (fun newval ->
- bind "index" (transl env arg2) (fun idx ->
- bind "arr" (transl env arg1) (fun arr ->
- Csequence(make_checkbound dbg [
- float_array_length (get_header_without_profinfo arr dbg) dbg;idx],
- float_array_set arr idx newval dbg))))
- end)
+ let newval =
+ match kind with
+ | Pfloatarray -> transl_unbox_float dbg env arg3
+ | _ -> transl env arg3
+ in
+ arrayset_safe kind (transl env arg1) (transl env arg2) newval dbg
| Pbytes_set(size, unsafe) ->
- return_unit dbg
- (bind "str" (transl env arg1) (fun str ->
- bind "index" (untag_int (transl env arg2) dbg) (fun idx ->
- bind "newval" (transl_unbox_sized size dbg env arg3) (fun newval ->
- check_bound unsafe size dbg (string_length str dbg)
- idx (unaligned_set size str idx newval dbg)))))
+ bytes_set size unsafe (transl env arg1) (transl env arg2)
+ (transl_unbox_sized size dbg env arg3) dbg
| Pbigstring_set(size, unsafe) ->
- return_unit dbg
- (bind "ba" (transl env arg1) (fun ba ->
- bind "index" (untag_int (transl env arg2) dbg) (fun idx ->
- bind "newval" (transl_unbox_sized size dbg env arg3) (fun newval ->
- bind "ba_data"
- (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
- (fun ba_data ->
- check_bound unsafe size dbg (bigstring_length ba dbg)
- idx (unaligned_set size ba_data idx newval dbg))))))
+ bigstring_set size unsafe (transl env arg1) (transl env arg2)
+ (transl_unbox_sized size dbg env arg3) dbg
| Pfield_computed | Psequand | Psequor | Pnot | Pnegint | Paddint
| Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint | Plsrint | Pasrint
fatal_errorf "Cmmgen.transl_prim_3: %a"
Printclambda_primitives.primitive p
-and transl_unbox_float dbg env = function
- Uconst(Uconst_ref(_, Some (Uconst_float f))) -> Cconst_float (f, dbg)
- | exp -> unbox_float dbg (transl env exp)
-
-and transl_unbox_int dbg env bi = function
- Uconst(Uconst_ref(_, Some (Uconst_int32 n))) ->
- Cconst_natint (Nativeint.of_int32 n, dbg)
- | Uconst(Uconst_ref(_, Some (Uconst_nativeint n))) ->
- Cconst_natint (n, dbg)
- | Uconst(Uconst_ref(_, Some (Uconst_int64 n))) ->
- if size_int = 8 then
- Cconst_natint (Int64.to_nativeint n, dbg)
- else begin
- let low = Int64.to_nativeint n in
- let high = Int64.to_nativeint (Int64.shift_right_logical n 32) in
- if big_endian then
- Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)]
- else
- Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)]
- end
- | Uprim(Pbintofint bi',[Uconst(Uconst_int i)],_) when bi = bi' ->
- Cconst_int (i, dbg)
- | exp -> unbox_int bi (transl env exp) dbg
+and transl_unbox_float dbg env exp =
+ unbox_float dbg (transl env exp)
-and transl_unbox_number dbg env bn arg =
- match bn with
- | Boxed_float _ -> transl_unbox_float dbg env arg
- | Boxed_integer (bi, _) -> transl_unbox_int dbg env bi arg
+and transl_unbox_int dbg env bi exp =
+ unbox_int dbg bi (transl env exp)
+
+(* transl_unbox_int, but may return garbage in upper bits *)
+and transl_unbox_int_low dbg env bi e =
+ let e = transl_unbox_int dbg env bi e in
+ if bi = Pint32 then low_32 dbg e else e
and transl_unbox_sized size dbg env exp =
match size with
- | Sixteen -> untag_int (transl env exp) dbg
+ | Sixteen ->
+ ignore_high_bit_int (untag_int (transl env exp) dbg)
| Thirty_two -> transl_unbox_int dbg env Pint32 exp
| Sixty_four -> transl_unbox_int dbg env Pint64 exp
and transl_let env str kind id exp body =
let dbg = Debuginfo.none in
+ let cexp = transl env exp in
let unboxing =
(* If [id] is a mutable variable (introduced to eliminate a local
reference) and it contains a type of unboxable numbers, then
(* It would be safe to always unbox in this case, but
we do it only if this indeed allows us to get rid of
some allocations in the bound expression. *)
- is_unboxed_number ~strict:false env exp
+ is_unboxed_number_cmm ~strict:false cexp
| _, Pgenval ->
(* Here we don't know statically that the bound expression
evaluates to an unboxable number type. We need to be stricter
and ensure that all possible branches in the expression
return a boxed value (of the same kind). Indeed, with GADTs,
different branches could return different types. *)
- is_unboxed_number ~strict:true env exp
+ is_unboxed_number_cmm ~strict:true cexp
| _, Pintval ->
No_unboxing
in
| No_unboxing | Boxed (_, true) | No_result ->
(* N.B. [body] must still be traversed even if [exp] will never return:
there may be constant closures inside that need lifting out. *)
- Clet(id, transl env exp, transl env body)
+ Clet(id, cexp, transl env body)
| Boxed (boxed_number, _false) ->
let unboxed_id = V.create_local (VP.name id) in
- Clet(VP.create unboxed_id, transl_unbox_number dbg env boxed_number exp,
+ Clet(VP.create unboxed_id, unbox_number dbg boxed_number cexp,
transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body)
and make_catch ncatch body handler dbg = match body with
| 1 -> transl env cases.(0)
| _ ->
let cases = Array.map (transl env) cases in
- let store = StoreExpForSwitch.mk_store () in
- let index =
- Array.map
- (fun j -> store.Switch.act_store j cases.(j))
- index in
- let n_index = Array.length index in
- let inters = ref []
- and this_high = ref (n_index-1)
- and this_low = ref (n_index-1)
- and this_act = ref index.(n_index-1) in
- for i = n_index-2 downto 0 do
- let act = index.(i) in
- if act = !this_act then
- decr this_low
- else begin
- inters := (!this_low, !this_high, !this_act) :: !inters ;
- this_high := i ;
- this_low := i ;
- this_act := act
- end
- done ;
- inters := (0, !this_high, !this_act) :: !inters ;
- match !inters with
- | [_] -> cases.(0)
- | inters ->
- bind "switcher" arg
- (fun a ->
- SwitcherBlocks.zyva
- loc
- (0,n_index-1)
- a
- (Array.of_list inters) store)
+ transl_switch_clambda loc arg index cases
and transl_letrec env bindings cont =
let dbg = Debuginfo.none in
(* Translate a function definition *)
-let transl_function ~ppf_dump f =
- let body =
- if Config.flambda then
- Un_anf.apply ~ppf_dump f.body ~what:f.label
- else
- f.body
- in
+let transl_function f =
+ let body = f.body in
let cmm_body =
let env = create_env ~environment_param:f.env in
if !Clflags.afl_instrument then
(* Translate all function definitions *)
-let rec transl_all_functions ~ppf_dump already_translated cont =
+let rec transl_all_functions already_translated cont =
match Cmmgen_state.next_function () with
| None -> cont, already_translated
| Some f ->
let sym = f.label in
if String.Set.mem sym already_translated then
- transl_all_functions ~ppf_dump already_translated cont
+ transl_all_functions already_translated cont
else begin
- transl_all_functions ~ppf_dump
+ transl_all_functions
(String.Set.add sym already_translated)
- ((f.dbg, transl_function ~ppf_dump f) :: cont)
+ ((f.dbg, transl_function f) :: cont)
end
-(* Emit constant closures *)
-
-let emit_constant_closure ((_, global_symb) as symb) fundecls clos_vars cont =
- let closure_symbol f =
- if Config.flambda then
- cdefine_symbol (f.label ^ "_closure", global_symb)
- else
- []
- in
- match fundecls with
- [] ->
- (* This should probably not happen: dead code has normally been
- eliminated and a closure cannot be accessed without going through
- a [Project_closure], which depends on the function. *)
- assert (clos_vars = []);
- cdefine_symbol symb @
- List.fold_right emit_constant clos_vars cont
- | f1 :: remainder ->
- let rec emit_others pos = function
- [] ->
- List.fold_right emit_constant clos_vars cont
- | f2 :: rem ->
- if f2.arity = 1 || f2.arity = 0 then
- Cint(infix_header pos) ::
- (closure_symbol f2) @
- Csymbol_address f2.label ::
- cint_const f2.arity ::
- emit_others (pos + 3) rem
- else
- Cint(infix_header pos) ::
- (closure_symbol f2) @
- Csymbol_address(curry_function f2.arity) ::
- cint_const f2.arity ::
- Csymbol_address f2.label ::
- emit_others (pos + 4) rem in
- Cint(black_closure_header (fundecls_size fundecls
- + List.length clos_vars)) ::
- cdefine_symbol symb @
- (closure_symbol f1) @
- if f1.arity = 1 || f1.arity = 0 then
- Csymbol_address f1.label ::
- cint_const f1.arity ::
- emit_others 3 remainder
- else
- Csymbol_address(curry_function f1.arity) ::
- cint_const f1.arity ::
- Csymbol_address f1.label ::
- emit_others 4 remainder
-
(* Emit constant blocks *)
let emit_constant_table symb elems =
match cst with
| Const_closure (global, fundecls, clos_vars) ->
let cmm =
- emit_constant_closure (symbol, global) fundecls clos_vars []
+ emit_constant_closure (symbol, global) fundecls
+ (List.fold_right emit_constant clos_vars []) []
in
c := (Cdata cmm) :: !c
| Const_table (global, elems) ->
c := (Cdata (emit_constant_table (symbol, global) elems)) :: !c)
- (Cmmgen_state.constants ());
- Cdata (Cmmgen_state.data_items ()) :: !c
+ (Cmmgen_state.get_and_clear_constants ());
+ Cdata (Cmmgen_state.get_and_clear_data_items ()) :: !c
-let transl_all_functions ~ppf_dump cont =
+let transl_all_functions cont =
let rec aux already_translated cont translated_functions =
if Cmmgen_state.no_more_functions ()
then cont, translated_functions
else
let translated_functions, already_translated =
- transl_all_functions ~ppf_dump already_translated translated_functions
+ transl_all_functions already_translated translated_functions
in
aux already_translated cont translated_functions
in
in
translated_functions @ cont
-(* Build the NULL terminated array of gc roots *)
-
-let emit_gc_roots_table ~symbols cont =
- let table_symbol = Compilenv.make_symbol (Some "gc_roots") in
- Cdata(Cglobal_symbol table_symbol ::
- Cdefine_symbol table_symbol ::
- List.map (fun s -> Csymbol_address s) symbols @
- [Cint 0n])
- :: cont
-
-(* Build preallocated blocks (used for Flambda [Initialize_symbol]
- constructs, and Clambda global module) *)
-
-let preallocate_block cont { Clambda.symbol; exported; tag; fields } =
- let space =
- (* These words will be registered as roots and as such must contain
- valid values, in case we are in no-naked-pointers mode. Likewise
- the block header must be black, below (see [caml_darken]), since
- the overall record may be referenced. *)
- List.map (fun field ->
- match field with
- | None ->
- Cint (Nativeint.of_int 1 (* Val_unit *))
- | Some (Uconst_field_int n) ->
- cint_const n
- | Some (Uconst_field_ref label) ->
- Csymbol_address label)
- fields
- in
- let data =
- Cint(black_block_header tag (List.length fields)) ::
- if exported then
- Cglobal_symbol symbol ::
- Cdefine_symbol symbol :: space
- else
- Cdefine_symbol symbol :: space
- in
- Cdata data :: cont
-
-let emit_preallocated_blocks preallocated_blocks cont =
- let symbols =
- List.map (fun ({ Clambda.symbol }:Clambda.preallocated_block) -> symbol)
- preallocated_blocks
- in
- let c1 = emit_gc_roots_table ~symbols cont in
- List.fold_left preallocate_block c1 preallocated_blocks
-
(* Translate a compilation unit *)
-let compunit ~ppf_dump (ulam, preallocated_blocks, constants) =
+let compunit (ulam, preallocated_blocks, constants) =
+ assert (Cmmgen_state.no_more_functions ());
let dbg = Debuginfo.none in
+ Cmmgen_state.set_structured_constants constants;
let init_code =
if !Clflags.afl_instrument then
Afl_instrument.instrument_initialiser (transl empty_env ulam)
else [ Reduce_code_size ];
fun_dbg = Debuginfo.none }] in
let c2 = transl_clambda_constants constants c1 in
- let c3 = transl_all_functions ~ppf_dump c2 in
+ let c3 = transl_all_functions c2 in
+ Cmmgen_state.set_structured_constants [];
let c4 = emit_preallocated_blocks preallocated_blocks c3 in
emit_cmm_data_items_for_constants c4
-
-(*
-CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
-{
- int li = 3, hi = Field(meths,0), mi;
- while (li < hi) { // no need to check the 1st time
- mi = ((li+hi) >> 1) | 1;
- if (tag < Field(meths,mi)) hi = mi-2;
- else li = mi;
- }
- *cache = (li-3)*sizeof(value)+1;
- return Field (meths, li-1);
-}
-*)
-
-let cache_public_method meths tag cache dbg =
- let raise_num = next_raise_count () in
- let cconst_int i = Cconst_int (i, dbg) in
- let li = V.create_local "*li*" and hi = V.create_local "*hi*"
- and mi = V.create_local "*mi*" and tagged = V.create_local "*tagged*" in
- Clet (
- VP.create li, cconst_int 3,
- Clet (
- VP.create hi, Cop(Cload (Word_int, Mutable), [meths], dbg),
- Csequence(
- ccatch
- (raise_num, [],
- create_loop
- (Clet(
- VP.create mi,
- Cop(Cor,
- [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi], dbg); cconst_int 1],
- dbg);
- cconst_int 1],
- dbg),
- Csequence(
- Cifthenelse
- (Cop (Ccmpi Clt,
- [tag;
- Cop(Cload (Word_int, Mutable),
- [Cop(Cadda,
- [meths; lsl_const (Cvar mi) log2_size_addr dbg],
- dbg)],
- dbg)], dbg),
- dbg, Cassign(hi, Cop(Csubi, [Cvar mi; cconst_int 2], dbg)),
- dbg, Cassign(li, Cvar mi),
- dbg),
- Cifthenelse
- (Cop(Ccmpi Cge, [Cvar li; Cvar hi], dbg),
- dbg, Cexit (raise_num, []),
- dbg, Ctuple [],
- dbg))))
- dbg,
- Ctuple [],
- dbg),
- Clet (
- VP.create tagged,
- Cop(Cadda, [lsl_const (Cvar li) log2_size_addr dbg;
- cconst_int(1 - 3 * size_addr)], dbg),
- Csequence(Cop (Cstore (Word_int, Assignment), [cache; Cvar tagged], dbg),
- Cvar tagged)))))
-
-(* CR mshinwell: These will be filled in by later pull requests. *)
-let placeholder_dbg () = Debuginfo.none
-let placeholder_fun_dbg ~human_name:_ = Debuginfo.none
-
-(* Generate an application function:
- (defun caml_applyN (a1 ... aN clos)
- (if (= clos.arity N)
- (app clos.direct a1 ... aN clos)
- (let (clos1 (app clos.code a1 clos)
- clos2 (app clos1.code a2 clos)
- ...
- closN-1 (app closN-2.code aN-1 closN-2))
- (app closN-1.code aN closN-1))))
-*)
-
-let apply_function_body arity =
- let dbg = placeholder_dbg in
- let arg = Array.make arity (V.create_local "arg") in
- for i = 1 to arity - 1 do arg.(i) <- V.create_local "arg" done;
- let clos = V.create_local "clos" in
- let env = empty_env in
- let rec app_fun clos n =
- if n = arity-1 then
- Cop(Capply typ_val,
- [get_field env (Cvar clos) 0 (dbg ()); Cvar arg.(n); Cvar clos],
- dbg ())
- else begin
- let newclos = V.create_local "clos" in
- Clet(VP.create newclos,
- Cop(Capply typ_val,
- [get_field env (Cvar clos) 0 (dbg ()); Cvar arg.(n); Cvar clos],
- dbg ()),
- app_fun newclos (n+1))
- end in
- let args = Array.to_list arg in
- let all_args = args @ [clos] in
- (args, clos,
- if arity = 1 then app_fun clos 0 else
- Cifthenelse(
- Cop(Ccmpi Ceq,
- [get_field env (Cvar clos) 1 (dbg ()); int_const (dbg ()) arity], dbg ()),
- dbg (),
- Cop(Capply typ_val,
- get_field env (Cvar clos) 2 (dbg ())
- :: List.map (fun s -> Cvar s) all_args,
- dbg ()),
- dbg (),
- app_fun clos 0,
- dbg ()))
-
-let send_function arity =
- let dbg = placeholder_dbg in
- let cconst_int i = Cconst_int (i, dbg ()) in
- let (args, clos', body) = apply_function_body (1+arity) in
- let cache = V.create_local "cache"
- and obj = List.hd args
- and tag = V.create_local "tag" in
- let env = empty_env in
- let clos =
- let cache = Cvar cache and obj = Cvar obj and tag = Cvar tag in
- let meths = V.create_local "meths" and cached = V.create_local "cached" in
- let real = V.create_local "real" in
- let mask = get_field env (Cvar meths) 1 (dbg ()) in
- let cached_pos = Cvar cached in
- let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths], dbg ());
- cconst_int(3*size_addr-1)], dbg ()) in
- let tag' = Cop(Cload (Word_int, Mutable), [tag_pos], dbg ()) in
- Clet (
- VP.create meths, Cop(Cload (Word_val, Mutable), [obj], dbg ()),
- Clet (
- VP.create cached,
- Cop(Cand, [Cop(Cload (Word_int, Mutable), [cache], dbg ()); mask],
- dbg ()),
- Clet (
- VP.create real,
- Cifthenelse(Cop(Ccmpa Cne, [tag'; tag], dbg ()),
- dbg (),
- cache_public_method (Cvar meths) tag cache (dbg ()),
- dbg (),
- cached_pos,
- dbg ()),
- Cop(Cload (Word_val, Mutable),
- [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths], dbg ());
- cconst_int(2*size_addr-1)], dbg ())], dbg ()))))
-
- in
- let body = Clet(VP.create clos', clos, body) in
- let cache = cache in
- let fun_name = "caml_send" ^ Int.to_string arity in
- let fun_args =
- [obj, typ_val; tag, typ_int; cache, typ_val]
- @ List.map (fun id -> (id, typ_val)) (List.tl args) in
- let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
- Cfunction
- {fun_name;
- fun_args = List.map (fun (arg, ty) -> VP.create arg, ty) fun_args;
- fun_body = body;
- fun_codegen_options = [];
- fun_dbg;
- }
-
-let apply_function arity =
- let (args, clos, body) = apply_function_body arity in
- let all_args = args @ [clos] in
- let fun_name = "caml_apply" ^ Int.to_string arity in
- let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
- Cfunction
- {fun_name;
- fun_args = List.map (fun arg -> (VP.create arg, typ_val)) all_args;
- fun_body = body;
- fun_codegen_options = [];
- fun_dbg;
- }
-
-(* Generate tuplifying functions:
- (defun caml_tuplifyN (arg clos)
- (app clos.direct #0(arg) ... #N-1(arg) clos)) *)
-
-let tuplify_function arity =
- let dbg = placeholder_dbg in
- let arg = V.create_local "arg" in
- let clos = V.create_local "clos" in
- let env = empty_env in
- let rec access_components i =
- if i >= arity
- then []
- else get_field env (Cvar arg) i (dbg ()) :: access_components(i+1) in
- let fun_name = "caml_tuplify" ^ Int.to_string arity in
- let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
- Cfunction
- {fun_name;
- fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
- fun_body =
- Cop(Capply typ_val,
- get_field env (Cvar clos) 2 (dbg ())
- :: access_components 0 @ [Cvar clos],
- dbg ());
- fun_codegen_options = [];
- fun_dbg;
- }
-
-(* Generate currying functions:
- (defun caml_curryN (arg clos)
- (alloc HDR caml_curryN_1 <arity (N-1)> caml_curry_N_1_app arg clos))
- (defun caml_curryN_1 (arg clos)
- (alloc HDR caml_curryN_2 <arity (N-2)> caml_curry_N_2_app arg clos))
- ...
- (defun caml_curryN_N-1 (arg clos)
- (let (closN-2 clos.vars[1]
- closN-3 closN-2.vars[1]
- ...
- clos1 clos2.vars[1]
- clos clos1.vars[1])
- (app clos.direct
- clos1.vars[0] ... closN-2.vars[0] clos.vars[0] arg clos)))
-
- Special "shortcut" functions are also generated to handle the
- case where a partially applied function is applied to all remaining
- arguments in one go. For instance:
- (defun caml_curry_N_1_app (arg2 ... argN clos)
- (let clos' clos.vars[1]
- (app clos'.direct clos.vars[0] arg2 ... argN clos')))
-
- Those shortcuts may lead to a quadratic number of application
- primitives being generated in the worst case, which resulted in
- linking time blowup in practice (PR#5933), so we only generate and
- use them when below a fixed arity 'max_arity_optimized'.
-*)
-
-let max_arity_optimized = 15
-let final_curry_function arity =
- let dbg = placeholder_dbg in
- let last_arg = V.create_local "arg" in
- let last_clos = V.create_local "clos" in
- let env = empty_env in
- let rec curry_fun args clos n =
- if n = 0 then
- Cop(Capply typ_val,
- get_field env (Cvar clos) 2 (dbg ()) ::
- args @ [Cvar last_arg; Cvar clos],
- dbg ())
- else
- if n = arity - 1 || arity > max_arity_optimized then
- begin
- let newclos = V.create_local "clos" in
- Clet(VP.create newclos,
- get_field env (Cvar clos) 3 (dbg ()),
- curry_fun (get_field env (Cvar clos) 2 (dbg ()) :: args)
- newclos (n-1))
- end else
- begin
- let newclos = V.create_local "clos" in
- Clet(VP.create newclos,
- get_field env (Cvar clos) 4 (dbg ()),
- curry_fun (get_field env (Cvar clos) 3 (dbg ()) :: args)
- newclos (n-1))
- end in
- let fun_name =
- "caml_curry" ^ Int.to_string arity ^ "_" ^ Int.to_string (arity-1)
- in
- let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
- Cfunction
- {fun_name;
- fun_args = [VP.create last_arg, typ_val; VP.create last_clos, typ_val];
- fun_body = curry_fun [] last_clos (arity-1);
- fun_codegen_options = [];
- fun_dbg;
- }
-
-let rec intermediate_curry_functions arity num =
- let dbg = placeholder_dbg in
- let env = empty_env in
- if num = arity - 1 then
- [final_curry_function arity]
- else begin
- let name1 = "caml_curry" ^ Int.to_string arity in
- let name2 = if num = 0 then name1 else name1 ^ "_" ^ Int.to_string num in
- let arg = V.create_local "arg" and clos = V.create_local "clos" in
- let fun_dbg = placeholder_fun_dbg ~human_name:name2 in
- Cfunction
- {fun_name = name2;
- fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
- fun_body =
- if arity - num > 2 && arity <= max_arity_optimized then
- Cop(Calloc,
- [alloc_closure_header 5 Debuginfo.none;
- Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
- int_const (dbg ()) (arity - num - 1);
- Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1) ^ "_app",
- dbg ());
- Cvar arg; Cvar clos],
- dbg ())
- else
- Cop(Calloc,
- [alloc_closure_header 4 (dbg ());
- Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
- int_const (dbg ()) 1; Cvar arg; Cvar clos],
- dbg ());
- fun_codegen_options = [];
- fun_dbg;
- }
- ::
- (if arity <= max_arity_optimized && arity - num > 2 then
- let rec iter i =
- if i <= arity then
- let arg = V.create_local (Printf.sprintf "arg%d" i) in
- (arg, typ_val) :: iter (i+1)
- else []
- in
- let direct_args = iter (num+2) in
- let rec iter i args clos =
- if i = 0 then
- Cop(Capply typ_val,
- (get_field env (Cvar clos) 2 (dbg ())) :: args @ [Cvar clos],
- dbg ())
- else
- let newclos = V.create_local "clos" in
- Clet(VP.create newclos,
- get_field env (Cvar clos) 4 (dbg ()),
- iter (i-1) (get_field env (Cvar clos) 3 (dbg ()) :: args)
- newclos)
- in
- let fun_args =
- List.map (fun (arg, ty) -> VP.create arg, ty)
- (direct_args @ [clos, typ_val])
- in
- let fun_name = name1 ^ "_" ^ Int.to_string (num+1) ^ "_app" in
- let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
- let cf =
- Cfunction
- {fun_name;
- fun_args;
- fun_body = iter (num+1)
- (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
- fun_codegen_options = [];
- fun_dbg;
- }
- in
- cf :: intermediate_curry_functions arity (num+1)
- else
- intermediate_curry_functions arity (num+1))
- end
-
-let curry_function arity =
- assert(arity <> 0);
- (* Functions with arity = 0 does not have a curry_function *)
- if arity > 0
- then intermediate_curry_functions arity 0
- else [tuplify_function (-arity)]
-
-module Int = Numbers.Int
-
-let default_apply = Int.Set.add 2 (Int.Set.add 3 Int.Set.empty)
- (* These apply funs are always present in the main program because
- the run-time system needs them (cf. runtime/<arch>.S) . *)
-
-let generic_functions shared units =
- let (apply,send,curry) =
- List.fold_left
- (fun (apply,send,curry) ui ->
- List.fold_right Int.Set.add ui.ui_apply_fun apply,
- List.fold_right Int.Set.add ui.ui_send_fun send,
- List.fold_right Int.Set.add ui.ui_curry_fun curry)
- (Int.Set.empty,Int.Set.empty,Int.Set.empty)
- units in
- let apply = if shared then apply else Int.Set.union apply default_apply in
- let accu = Int.Set.fold (fun n accu -> apply_function n :: accu) apply [] in
- let accu = Int.Set.fold (fun n accu -> send_function n :: accu) send accu in
- Int.Set.fold (fun n accu -> curry_function n @ accu) curry accu
-
-(* Generate the entry point *)
-
-let entry_point namelist =
- let dbg = placeholder_dbg in
- let cconst_int i = Cconst_int (i, dbg ()) in
- let cconst_symbol sym = Cconst_symbol (sym, dbg ()) in
- let incr_global_inited () =
- Cop(Cstore (Word_int, Assignment),
- [cconst_symbol "caml_globals_inited";
- Cop(Caddi, [Cop(Cload (Word_int, Mutable),
- [cconst_symbol "caml_globals_inited"], dbg ());
- cconst_int 1], dbg ())], dbg ()) in
- let body =
- List.fold_right
- (fun name next ->
- let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in
- Csequence(Cop(Capply typ_void,
- [cconst_symbol entry_sym], dbg ()),
- Csequence(incr_global_inited (), next)))
- namelist (cconst_int 1) in
- let fun_name = "caml_program" in
- let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
- Cfunction {fun_name;
- fun_args = [];
- fun_body = body;
- fun_codegen_options = [Reduce_code_size];
- fun_dbg;
- }
-
-(* Generate the table of globals *)
-
-let cint_zero = Cint 0n
-
-let global_table namelist =
- let mksym name =
- Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "gc_roots"))
- in
- Cdata(Cglobal_symbol "caml_globals" ::
- Cdefine_symbol "caml_globals" ::
- List.map mksym namelist @
- [cint_zero])
-
-let reference_symbols namelist =
- let mksym name = Csymbol_address name in
- Cdata(List.map mksym namelist)
-
-let global_data name v =
- Cdata(emit_structured_constant (name, Global)
- (Uconst_string (Marshal.to_string v [])) [])
-
-let globals_map v = global_data "caml_globals_map" v
-
-(* Generate the master table of frame descriptors *)
-
-let frame_table namelist =
- let mksym name =
- Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "frametable"))
- in
- Cdata(Cglobal_symbol "caml_frametable" ::
- Cdefine_symbol "caml_frametable" ::
- List.map mksym namelist
- @ [cint_zero])
-
-(* Generate the master table of Spacetime shapes *)
-
-let spacetime_shapes namelist =
- let mksym name =
- Csymbol_address (
- Compilenv.make_symbol ~unitname:name (Some "spacetime_shapes"))
- in
- Cdata(Cglobal_symbol "caml_spacetime_shapes" ::
- Cdefine_symbol "caml_spacetime_shapes" ::
- List.map mksym namelist
- @ [cint_zero])
-
-(* Generate the table of module data and code segments *)
-
-let segment_table namelist symbol begname endname =
- let addsyms name lst =
- Csymbol_address (Compilenv.make_symbol ~unitname:name (Some begname)) ::
- Csymbol_address (Compilenv.make_symbol ~unitname:name (Some endname)) ::
- lst
- in
- Cdata(Cglobal_symbol symbol ::
- Cdefine_symbol symbol ::
- List.fold_right addsyms namelist [cint_zero])
-
-let data_segment_table namelist =
- segment_table namelist "caml_data_segments" "data_begin" "data_end"
-
-let code_segment_table namelist =
- segment_table namelist "caml_code_segments" "code_begin" "code_end"
-
-(* Initialize a predefined exception *)
-
-let predef_exception i name =
- let name_sym = Compilenv.new_const_symbol () in
- let data_items =
- emit_block name_sym Local (string_header (String.length name))
- (emit_string_constant name [])
- in
- let exn_sym = "caml_exn_" ^ name in
- let tag = Obj.object_tag in
- let size = 2 in
- let fields =
- (Csymbol_address name_sym)
- :: (cint_const (-i - 1))
- :: data_items
- in
- let data_items = emit_block exn_sym Global (block_header tag size) fields in
- Cdata data_items
-
-(* Header for a plugin *)
-
-let plugin_header units =
- let mk (ui,crc) =
- { dynu_name = ui.ui_name;
- dynu_crc = crc;
- dynu_imports_cmi = ui.ui_imports_cmi;
- dynu_imports_cmx = ui.ui_imports_cmx;
- dynu_defines = ui.ui_defines
- } in
- global_data "caml_plugin_header"
- { dynu_magic = Config.cmxs_magic_number; dynu_units = List.map mk units }
-
-let reset () =
- Cmmgen_state.reset ()
(* Translation from closed lambda to C-- *)
-val compunit:
- ppf_dump:Format.formatter
- -> Clambda.ulambda
+val compunit
+ : Clambda.ulambda
* Clambda.preallocated_block list
* Clambda.preallocated_constant list
-> Cmm.phrase list
-
-val apply_function: int -> Cmm.phrase
-val send_function: int -> Cmm.phrase
-val curry_function: int -> Cmm.phrase list
-val generic_functions: bool -> Cmx_format.unit_infos list -> Cmm.phrase list
-val entry_point: string list -> Cmm.phrase
-val global_table: string list -> Cmm.phrase
-val reference_symbols: string list -> Cmm.phrase
-val globals_map:
- (string * Digest.t option * Digest.t option * string list) list -> Cmm.phrase
-val frame_table: string list -> Cmm.phrase
-val spacetime_shapes: string list -> Cmm.phrase
-val data_segment_table: string list -> Cmm.phrase
-val code_segment_table: string list -> Cmm.phrase
-val predef_exception: int -> string -> Cmm.phrase
-val plugin_header: (Cmx_format.unit_infos * Digest.t) list -> Cmm.phrase
-val black_block_header: (*tag:*)int -> (*size:*)int -> nativeint
-
-val reset : unit -> unit
type t = {
mutable constants : constant S.Map.t;
mutable data_items : Cmm.data_item list list;
+ structured_constants : (string, Clambda.ustructured_constant) Hashtbl.t;
functions : Clambda.ufunction Queue.t;
}
constants = S.Map.empty;
data_items = [];
functions = Queue.create ();
+ structured_constants = Hashtbl.create 16;
}
let state = empty
-let reset () =
- state.constants <- S.Map.empty;
- state.data_items <- [];
- Queue.clear state.functions
-
let add_constant sym cst =
state.constants <- S.Map.add sym cst state.constants
let add_function func =
Queue.add func state.functions
-let constants () = state.constants
+let get_and_clear_constants () =
+ let constants = state.constants in
+ state.constants <- S.Map.empty;
+ constants
-let data_items () = List.concat (List.rev state.data_items)
+let get_and_clear_data_items () =
+ let data_items = List.concat (List.rev state.data_items) in
+ state.data_items <- [];
+ data_items
let next_function () =
match Queue.take state.functions with
let no_more_functions () =
Queue.is_empty state.functions
+
+let set_structured_constants l =
+ Hashtbl.clear state.structured_constants;
+ List.iter
+ (fun (c : Clambda.preallocated_constant) ->
+ Hashtbl.add state.structured_constants c.symbol c.definition
+ )
+ l
+
+let get_structured_constant s =
+ Hashtbl.find_opt state.structured_constants s
+
+let structured_constant_of_sym s =
+ match Compilenv.structured_constant_of_symbol s with
+ | None -> get_structured_constant s
+ | Some _ as r -> r
[@@@ocaml.warning "+a-4-30-40-41-42"]
-val reset : unit -> unit
-
type is_global = Global | Local
type constant =
val add_function : Clambda.ufunction -> unit
-val constants : unit -> constant Misc.Stdlib.String.Map.t
+val get_and_clear_constants : unit -> constant Misc.Stdlib.String.Map.t
-val data_items : unit -> Cmm.data_item list
+val get_and_clear_data_items : unit -> Cmm.data_item list
val next_function : unit -> Clambda.ufunction option
val no_more_functions : unit -> bool
+
+val set_structured_constants : Clambda.preallocated_constant list -> unit
+
+(* Also looks up using Compilenv.structured_constant_of_symbol *)
+val structured_constant_of_sym : string -> Clambda.ustructured_constant option
(* Unconstrained regs with degree < number of available registers *)
let unconstrained = ref [] in
+ (* Reset the stack slot counts *)
+ let num_stack_slots = Array.make Proc.num_register_classes 0 in
+
(* Preallocate the spilled registers in the stack.
Split the remaining registers into constrained and unconstrained. *)
let remove_reg reg =
let cl = Proc.register_class reg in
if reg.spill then begin
(* Preallocate the registers in the stack *)
- let nslots = Proc.num_stack_slots.(cl) in
+ let nslots = num_stack_slots.(cl) in
let conflict = Array.make nslots false in
List.iter
(fun r ->
let slot = ref 0 in
while !slot < nslots && conflict.(!slot) do incr slot done;
reg.loc <- Stack(Local !slot);
- if !slot >= nslots then Proc.num_stack_slots.(cl) <- !slot + 1
+ if !slot >= nslots then num_stack_slots.(cl) <- !slot + 1
end else if reg.degree < Proc.num_available_registers.(cl) then
unconstrained := reg :: !unconstrained
else begin
if start >= num_regs then 0 else start)
end else begin
(* Sorry, we must put the pseudoreg in a stack location *)
- let nslots = Proc.num_stack_slots.(cl) in
+ let nslots = num_stack_slots.(cl) in
let score = Array.make nslots 0 in
(* Compute the scores as for registers *)
List.iter
else begin
(* Allocate a new stack slot *)
reg.loc <- Stack(Local nslots);
- Proc.num_stack_slots.(cl) <- nslots + 1
+ num_stack_slots.(cl) <- nslots + 1
end
end;
(* Cancel the preferences of this register so that they don't influence
transitively the allocation of registers that prefer this reg. *)
reg.prefer <- [] in
- (* Reset the stack slot counts *)
- for i = 0 to Proc.num_register_classes - 1 do
- Proc.num_stack_slots.(i) <- 0;
- done;
-
(* First pass: preallocate spill registers and split remaining regs
Second pass: assign locations to constrained regs
Third pass: assign locations to unconstrained regs *)
List.iter remove_reg (Reg.all_registers());
OrderedRegSet.iter assign_location !constrained;
- List.iter assign_location !unconstrained
+ List.iter assign_location !unconstrained;
+ num_stack_slots
(* Register allocation by coloring of the interference graph *)
-val allocate_registers: unit -> unit
+val allocate_registers: unit -> int array
open Mach
-(* [deadcode i] returns a pair of an optimized instruction [i']
- and a set of registers live "before" instruction [i]. *)
+module Int = Numbers.Int
+
+type d = {
+ i : instruction; (* optimized instruction *)
+ regs : Reg.Set.t; (* a set of registers live "before" instruction [i] *)
+ exits : Int.Set.t; (* indexes of Iexit instructions "live before" [i] *)
+}
+
+let append a b =
+ let rec append a b =
+ match a.desc with
+ | Iend -> b
+ | _ -> { a with next = append a.next b }
+ in
+ match b.desc with
+ | Iend -> a
+ | _ -> append a b
let rec deadcode i =
let arg =
in
match i.desc with
| Iend | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) | Iraise _ ->
- (i, Reg.add_set_array i.live arg)
+ let regs = Reg.add_set_array i.live arg in
+ { i; regs; exits = Int.Set.empty; }
| Iop op ->
- let (s, before) = deadcode i.next in
+ let s = deadcode i.next in
if Proc.op_is_pure op (* no side effects *)
- && Reg.disjoint_set_array before i.res (* results are not used after *)
+ && Reg.disjoint_set_array s.regs i.res (* results are not used after *)
&& not (Proc.regs_are_volatile arg) (* no stack-like hard reg *)
&& not (Proc.regs_are_volatile i.res) (* is involved *)
then begin
assert (Array.length i.res > 0); (* sanity check *)
- (s, before)
+ s
end else begin
- ({i with next = s}, Reg.add_set_array i.live arg)
+ { i = {i with next = s.i};
+ regs = Reg.add_set_array i.live arg;
+ exits = s.exits;
+ }
end
| Iifthenelse(test, ifso, ifnot) ->
- let (ifso', _) = deadcode ifso in
- let (ifnot', _) = deadcode ifnot in
- let (s, _) = deadcode i.next in
- ({i with desc = Iifthenelse(test, ifso', ifnot'); next = s},
- Reg.add_set_array i.live arg)
+ let ifso' = deadcode ifso in
+ let ifnot' = deadcode ifnot in
+ let s = deadcode i.next in
+ { i = {i with desc = Iifthenelse(test, ifso'.i, ifnot'.i); next = s.i};
+ regs = Reg.add_set_array i.live arg;
+ exits = Int.Set.union s.exits
+ (Int.Set.union ifso'.exits ifnot'.exits);
+ }
| Iswitch(index, cases) ->
- let cases' = Array.map (fun c -> fst (deadcode c)) cases in
- let (s, _) = deadcode i.next in
- ({i with desc = Iswitch(index, cases'); next = s},
- Reg.add_set_array i.live arg)
+ let dc = Array.map deadcode cases in
+ let cases' = Array.map (fun c -> c.i) dc in
+ let s = deadcode i.next in
+ { i = {i with desc = Iswitch(index, cases'); next = s.i};
+ regs = Reg.add_set_array i.live arg;
+ exits = Array.fold_left
+ (fun acc c -> Int.Set.union acc c.exits) s.exits dc;
+ }
| Icatch(rec_flag, handlers, body) ->
- let (body', _) = deadcode body in
- let handlers' =
- List.map (fun (nfail, handler) ->
- let (handler', _) = deadcode handler in
- nfail, handler')
- handlers
- in
- let (s, _) = deadcode i.next in
- ({i with desc = Icatch(rec_flag, handlers', body'); next = s}, i.live)
- | Iexit _nfail ->
- (i, i.live)
+ let body' = deadcode body in
+ let s = deadcode i.next in
+ let handlers' = Int.Map.map deadcode (Int.Map.of_list handlers) in
+ (* Previous passes guarantee that indexes of handlers are unique
+ across the entire function and Iexit instructions refer
+ to the correctly scoped handlers.
+ We do not rely on it here, for safety. *)
+ let rec add_live nfail (live_exits, used_handlers) =
+ if Int.Set.mem nfail live_exits then
+ (live_exits, used_handlers)
+ else
+ let live_exits = Int.Set.add nfail live_exits in
+ match Int.Map.find_opt nfail handlers' with
+ | None -> (live_exits, used_handlers)
+ | Some handler ->
+ let used_handlers = (nfail, handler) :: used_handlers in
+ match rec_flag with
+ | Cmm.Nonrecursive -> (live_exits, used_handlers)
+ | Cmm.Recursive ->
+ Int.Set.fold add_live handler.exits (live_exits, used_handlers)
+ in
+ let live_exits, used_handlers =
+ Int.Set.fold add_live body'.exits (Int.Set.empty, [])
+ in
+ (* Remove exits that are going out of scope. *)
+ let used_handler_indexes = Int.Set.of_list (List.map fst used_handlers) in
+ let live_exits = Int.Set.diff live_exits used_handler_indexes in
+ (* For non-recursive catch, live exits referenced in handlers are free. *)
+ let live_exits =
+ match rec_flag with
+ | Cmm.Recursive -> live_exits
+ | Cmm.Nonrecursive ->
+ List.fold_left (fun exits (_,h) -> Int.Set.union h.exits exits)
+ live_exits
+ used_handlers
+ in
+ let exits = Int.Set.union s.exits live_exits in
+ begin match used_handlers with
+ | [] -> (* Simplify catch without handlers *)
+ { i = append body'.i s.i;
+ regs = body'.regs;
+ exits;
+ }
+ | _ ->
+ let handlers = List.map (fun (n,h) -> (n,h.i)) used_handlers in
+ { i = { i with desc = Icatch(rec_flag, handlers, body'.i); next = s.i };
+ regs = i.live;
+ exits;
+ }
+ end
+ | Iexit nfail ->
+ { i; regs = i.live; exits = Int.Set.singleton nfail; }
| Itrywith(body, handler) ->
- let (body', _) = deadcode body in
- let (handler', _) = deadcode handler in
- let (s, _) = deadcode i.next in
- ({i with desc = Itrywith(body', handler'); next = s}, i.live)
+ let body' = deadcode body in
+ let handler' = deadcode handler in
+ let s = deadcode i.next in
+ { i = {i with desc = Itrywith(body'.i, handler'.i); next = s.i};
+ regs = i.live;
+ exits = Int.Set.union s.exits
+ (Int.Set.union body'.exits handler'.exits);
+ }
let fundecl f =
- let (new_body, _) = deadcode f.fun_body in
- {f with fun_body = new_body}
+ let new_body = deadcode f.fun_body in
+ {f with fun_body = new_body.i}
open! Int_replace_polymorphic_compare
-module L = Linearize
+module L = Linear
module Make (S : Compute_ranges_intf.S_functor) = struct
module Subrange_state = S.Subrange_state
subrange_info : Subrange_info.t;
}
- let create ~(start_insn : Linearize.instruction)
+ let create ~(start_insn : L.instruction)
~start_pos ~start_pos_offset
~end_pos ~end_pos_offset
~subrange_info =
| Lend -> first_insn
| Lprologue | Lop _ | Lreloadretaddr | Lreturn | Llabel _
| Lbranch _ | Lcondbranch _ | Lcondbranch3 _ | Lswitch _
- | Lentertrap | Lpushtrap _ | Lpoptrap | Lraise _ ->
+ | Lentertrap | Lpushtrap _ | Lpoptrap | Ladjust_trap_depth _
+ | Lraise _ ->
let subrange_state =
Subrange_state.advance_over_instruction subrange_state insn
in
the documentation on module type [S], below.
*)
-module L = Linearize
+module L = Linear
(** The type of caller-defined contextual state associated with subranges.
This may be used to track information throughout the range-computing
module Index : Identifiable.S
(** The module [Key] corresponds to the identifiers that define the ranges in
- [Linearize] instructions. Each instruction should have two sets of keys,
+ [Linear] instructions. Each instruction should have two sets of keys,
[available_before] and [available_across], with accessor functions of
these names being provided to retrieve them. The notion of "availability"
is not prescribed. The availability sets are used to compute subranges
(** This module type is the result type of the [Compute_ranges.Make] functor.
The _ranges_ being computed are composed of contiguous _subranges_ delimited
- by two labels (of type [Linearize.label]). These labels will be added by
+ by two labels (of type [Linear.label]). These labels will be added by
this pass to the code being inspected, which is why the [create] function in
the result of the functor returns not only the ranges but also the updated
function with the labels added. The [start_pos_offset] and [end_pos_offset]
val info : t -> Subrange_info.t
(** The label at the start of the range. *)
- val start_pos : t -> Linearize.label
+ val start_pos : t -> Linear.label
(** How many bytes from the label at [start_pos] the range actually
commences. If this value is zero, then the first byte of the range
val start_pos_offset : t -> int
(** The label at the end of the range. *)
- val end_pos : t -> Linearize.label
+ val end_pos : t -> Linear.label
(** Like [start_pos_offset], but analogously for the end of the range. (The
sense is not inverted; a positive [end_pos_offset] means the range ends
cross an extremity of any other range. (This should be satisfied in
typical uses because the offsets are typically zero or one.) If there
are no ranges supplied then [None] is returned. *)
- val estimate_lowest_address : t -> (Linearize.label * int) option
+ val estimate_lowest_address : t -> (Linear.label * int) option
(** Fold over all subranges within the given range. *)
val fold
(** Compute ranges for the code in the given linearized function
declaration, returning the ranges as a value of type [t] and the
rewritten code that must go forward for emission. *)
- val create : Linearize.fundecl -> t * Linearize.fundecl
+ val create : Linear.fundecl -> t * Linear.fundecl
(** Iterate through ranges. Each range is associated with an index. *)
val iter : t -> f:(Index.t -> Range.t -> unit) -> unit
(* Generation of assembly code *)
-val fundecl: Linearize.fundecl -> unit
+val fundecl: Linear.fundecl -> unit
val data: Cmm.data_item list -> unit
val begin_assembly: unit -> unit
val end_assembly: unit -> unit
open Proc
open Reg
open Mach
-open Linearize
+open Linear
open Emitaux
module String = Misc.Stdlib.String
let stack_offset = ref 0
(* Layout of the stack frame *)
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
let frame_size () = (* includes return address *)
let sz =
let sym32 ?ofs s = mem_sym ?ofs DWORD (emit_symbol s)
+let domain_field f r =
+ mem32 DWORD (Domainstate.idx_of_field f * 8) r
+
+let load_domain_state r =
+ I.mov (sym32 "Caml_state") r
+
let reg = function
| { loc = Reg r } -> register_name r
| { loc = Stack(Incoming n | Outgoing n) } when n < 0 ->
D.global lbl;
_label lbl
+(* Output .text section directive, or named .text.caml.<name> if enabled. *)
+
+let emit_named_text_section func_name =
+ if !Clflags.function_sections then
+ begin match system with
+ | S_macosx | S_mingw | S_cygwin | S_win32 -> D.text ()
+ | _ -> D.section [ ".text.caml."^(emit_symbol func_name) ]
+ (Some "ax") ["@progbits"]
+ end
+ else D.text ()
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (Proc.prologue_required ());
+ assert (!prologue_required);
let n = frame_size() - 4 in
if n > 0 then begin
I.sub (int n) esp;
if !fastcode_flag then begin
let lbl_redo = new_label() in
def_label lbl_redo;
- I.mov (sym32 "caml_young_ptr") eax;
+ load_domain_state ebx;
+ I.mov (domain_field Domain_young_ptr RBX) eax;
I.sub (int n) eax;
- I.mov eax (sym32 "caml_young_ptr");
- I.cmp (sym32 "caml_young_limit") eax;
+ I.cmp (domain_field Domain_young_limit RBX) eax;
let lbl_call_gc = new_label() in
let lbl_frame = record_frame_label i.live false Debuginfo.none in
I.jb (label lbl_call_gc);
+ I.mov eax (domain_field Domain_young_ptr RBX);
I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
end;
begin match lbl2 with
None -> ()
- | Some lbl -> I.jg (label lbl)
+ | Some lbl -> I.ja (label lbl)
end
| Lswitch jumptbl ->
let lbl = new_label() in
for i = 0 to Array.length jumptbl - 1 do
D.long (ConstLabel (emit_label jumptbl.(i)))
done;
- D.text ()
+ emit_named_text_section !function_name
| Lentertrap ->
()
+ | Ladjust_trap_depth { delta_traps } ->
+ let delta = trap_frame_size * delta_traps in
+ cfi_adjust_cfa_offset delta;
+ stack_offset := !stack_offset + delta
| Lpushtrap { lbl_handler; } ->
I.push (label lbl_handler);
if trap_frame_size > 8 then
I.sub (int (trap_frame_size - 8)) esp;
- I.push (sym32 "caml_exception_pointer");
+ load_domain_state edx;
+ I.push (domain_field Domain_exception_pointer RDX);
cfi_adjust_cfa_offset trap_frame_size;
- I.mov esp (sym32 "caml_exception_pointer");
+ I.mov esp (domain_field Domain_exception_pointer RDX);
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
- I.pop (sym32 "caml_exception_pointer");
- I.add (int (trap_frame_size - 4)) esp;
+ I.mov edx (mem32 DWORD 4 RSP);
+ load_domain_state edx;
+ I.pop (domain_field Domain_exception_pointer RDX);
+ I.pop edx;
+ if trap_frame_size > 8 then
+ I.add (int (trap_frame_size - 8)) esp;
cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise k ->
begin match k with
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_regular ->
+ load_domain_state ebx;
+ I.mov (int 0) (domain_field Domain_backtrace_pos RBX);
+ emit_call "caml_raise_exn";
+ record_frame Reg.Set.empty true i.dbg
+ | Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
- | Cmm.Raise_notrace ->
- I.mov (sym32 "caml_exception_pointer") esp;
- I.pop (sym32 "caml_exception_pointer");
+ | Lambda.Raise_notrace ->
+ load_domain_state ebx;
+ I.mov (domain_field Domain_exception_pointer RBX) esp;
+ I.pop (domain_field Domain_exception_pointer RBX);
if trap_frame_size > 8 then
I.add (int (trap_frame_size - 8)) esp;
I.pop ebx;
| _ ->
emit_instr fallthrough i;
emit_all
- (system = S_win32 || Linearize.has_fallthrough i.desc)
+ (system = S_win32 || Linear.has_fallthrough i.desc)
i.next
(* Emission of a function declaration *)
call_gc_sites := [];
bound_error_sites := [];
bound_error_call := 0;
- D.text ();
+ for i = 0 to Proc.num_register_classes - 1 do
+ num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+ done;
+ prologue_required := fundecl.fun_prologue_required;
+ emit_named_text_section !function_name;
add_def_symbol fundecl.fun_name;
D.align (if system = S_win32 then 4 else 16);
D.global (emit_symbol fundecl.fun_name);
if system = S_win32 then begin
D.mode386 ();
D.model "FLAT";
- D.extrn "_caml_young_ptr" DWORD;
- D.extrn "_caml_young_limit" DWORD;
- D.extrn "_caml_exception_pointer" DWORD;
D.extrn "_caml_extra_params" DWORD;
D.extrn "_caml_call_gc" PROC;
D.extrn "_caml_c_call" PROC;
D.extrn "_caml_alloc3" PROC;
D.extrn "_caml_ml_array_bound_error" PROC;
D.extrn "_caml_raise_exn" PROC;
+ D.extrn "_Caml_state" DWORD;
end;
D.data ();
emit_global_label "data_begin";
-
- D.text ();
+ emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
emit_global_label "code_begin"
let end_assembly() =
List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
end;
- D.text ();
-
+ emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
emit_global_label "code_end";
D.data ();
if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
let eax = phys_reg 0
+let ebx = phys_reg 1
let ecx = phys_reg 2
let edx = phys_reg 3
all_phys_regs
| Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call
| Iop(Iintop(Idiv | Imod)) -> [| eax; edx |]
- | Iop(Ialloc _ | Iintop Imulh) -> [| eax |]
+ | Iop(Ialloc _) -> [| eax; ebx |]
+ | Iop(Iintop Imulh) -> [| eax |]
| Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| eax |]
| Iop(Iintoffloat) -> [| eax |]
| Iifthenelse(Ifloattest _, _, _) -> [| eax |]
+ | Itrywith _ -> [| edx |]
| _ -> [||]
let destroyed_at_raise = all_phys_regs
(* Layout of the stack frame *)
-let num_stack_slots = [| 0; 0 |]
-let contains_calls = ref false
-
-let frame_required () =
+let frame_required fd =
let frame_size_at_top_of_function =
(* cf. [frame_size] in emit.mlp. *)
- Misc.align (4*num_stack_slots.(0) + 8*num_stack_slots.(1) + 4)
+ Misc.align (4*fd.fun_num_stack_slots.(0) + 8*fd.fun_num_stack_slots.(1) + 4)
stack_alignment
in
frame_size_at_top_of_function > 4
-let prologue_required () =
- frame_required ()
+let prologue_required fd =
+ frame_required fd
(* Calling the assembler *)
end
-let fundecl f =
- (new reload)#fundecl f
+let fundecl f num_stack_slots =
+ (new reload)#fundecl f num_stack_slots
(* *)
(**************************************************************************)
-let () = let module M = Schedgen in () (* to create a dependency *)
+open! Schedgen (* to create a dependency *)
(* Scheduling is turned off because our model does not fit the 486
nor the Pentium very well. In particular, it messes up with the
| _ -> (Ispecific(Ipush), exp)
method! mark_c_tailcall =
- Proc.contains_calls := true
+ contains_calls := true
method! emit_extcall_args env args =
let rec size_pushes = function
float arguments in integer registers, PR#6227.) *)
let add_pref weight r1 r2 =
- if weight > 0 then begin
- let i = r1.stamp and j = r2.stamp in
- if i <> j
- && r1.loc = Unknown
- && Proc.register_class r1 = Proc.register_class r2
- && (let p = if i < j then (i, j) else (j, i) in
- not (IntPairSet.mem p !mat))
- then r1.prefer <- (r2, weight) :: r1.prefer
- end in
+ let i = r1.stamp and j = r2.stamp in
+ if i <> j
+ && r1.loc = Unknown
+ && Proc.register_class r1 = Proc.register_class r2
+ && (let p = if i < j then (i, j) else (j, i) in
+ not (IntPairSet.mem p !mat))
+ then r1.prefer <- (r2, weight) :: r1.prefer
+ in
(* Add a mutual preference between two regs *)
let add_mutual_pref weight r1 r2 =
(* Compute preferences and spill costs *)
let rec prefer weight i =
+ assert (weight > 0);
add_spill_cost weight i.arg;
add_spill_cost weight i.res;
match i.desc with
| Iop _ ->
prefer weight i.next
| Iifthenelse(_tst, ifso, ifnot) ->
- prefer (weight / 2) ifso;
- prefer (weight / 2) ifnot;
+ prefer weight ifso;
+ prefer weight ifnot;
prefer weight i.next
| Iswitch(_index, cases) ->
for i = 0 to Array.length cases - 1 do
- prefer (weight / 2) cases.(i)
+ prefer weight cases.(i)
done;
prefer weight i.next
| Icatch(rec_flag, handlers, body) ->
prefer weight body;
- List.iter (fun (_nfail, handler) ->
- let weight =
- match rec_flag with
- | Cmm.Recursive ->
- (* Avoid overflow of weight and spill_cost *)
- if weight < 1000 then 8 * weight else weight
- | Cmm.Nonrecursive ->
- weight in
- prefer weight handler) handlers;
+ let weight_h =
+ match rec_flag with
+ | Cmm.Recursive ->
+ (* Avoid overflow of weight and spill_cost *)
+ if weight < 1000 then 8 * weight else weight
+ | Cmm.Nonrecursive ->
+ weight in
+ List.iter (fun (_nfail, handler) -> prefer weight_h handler) handlers;
prefer weight i.next
| Iexit _ ->
()
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+open Mach
+
+(* Transformation of Mach code into a list of pseudo-instructions. *)
+type label = Cmm.label
+
+type instruction =
+ { mutable desc: instruction_desc;
+ mutable next: instruction;
+ arg: Reg.t array;
+ res: Reg.t array;
+ dbg: Debuginfo.t;
+ live: Reg.Set.t }
+
+and instruction_desc =
+ | Lprologue
+ | Lend
+ | Lop of Mach.operation
+ | Lreloadretaddr
+ | Lreturn
+ | Llabel of label
+ | Lbranch of label
+ | Lcondbranch of Mach.test * label
+ | Lcondbranch3 of label option * label option * label option
+ | Lswitch of label array
+ | Lentertrap
+ | Ladjust_trap_depth of { delta_traps : int; }
+ | Lpushtrap of { lbl_handler : label; }
+ | Lpoptrap
+ | Lraise of Lambda.raise_kind
+
+let has_fallthrough = function
+ | Lreturn | Lbranch _ | Lswitch _ | Lraise _
+ | Lop Itailcall_ind _ | Lop (Itailcall_imm _) -> false
+ | _ -> true
+
+type fundecl =
+ { fun_name: string;
+ fun_body: instruction;
+ fun_fast: bool;
+ fun_dbg : Debuginfo.t;
+ fun_spacetime_shape : Mach.spacetime_shape option;
+ fun_tailrec_entry_point_label : label;
+ fun_contains_calls: bool;
+ fun_num_stack_slots: int array;
+ fun_frame_required: bool;
+ fun_prologue_required: bool;
+ }
+
+(* Invert a test *)
+
+let invert_integer_test = function
+ Isigned cmp -> Isigned(Cmm.negate_integer_comparison cmp)
+ | Iunsigned cmp -> Iunsigned(Cmm.negate_integer_comparison cmp)
+
+let invert_test = function
+ Itruetest -> Ifalsetest
+ | Ifalsetest -> Itruetest
+ | Iinttest(cmp) -> Iinttest(invert_integer_test cmp)
+ | Iinttest_imm(cmp, n) -> Iinttest_imm(invert_integer_test cmp, n)
+ | Ifloattest(cmp) -> Ifloattest(Cmm.negate_float_comparison cmp)
+ | Ieventest -> Ioddtest
+ | Ioddtest -> Ieventest
+
+(* The "end" instruction *)
+
+let rec end_instr =
+ { desc = Lend;
+ next = end_instr;
+ arg = [||];
+ res = [||];
+ dbg = Debuginfo.none;
+ live = Reg.Set.empty }
+
+(* Cons an instruction (live, debug empty) *)
+
+let instr_cons d a r n =
+ { desc = d; next = n; arg = a; res = r;
+ dbg = Debuginfo.none; live = Reg.Set.empty }
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Transformation of Mach code into a list of pseudo-instructions. *)
+
+type label = Cmm.label
+
+type instruction =
+ { mutable desc: instruction_desc;
+ mutable next: instruction;
+ arg: Reg.t array;
+ res: Reg.t array;
+ dbg: Debuginfo.t;
+ live: Reg.Set.t }
+
+and instruction_desc =
+ | Lprologue
+ | Lend
+ | Lop of Mach.operation
+ | Lreloadretaddr
+ | Lreturn
+ | Llabel of label
+ | Lbranch of label
+ | Lcondbranch of Mach.test * label
+ | Lcondbranch3 of label option * label option * label option
+ | Lswitch of label array
+ | Lentertrap
+ | Ladjust_trap_depth of { delta_traps : int; }
+ | Lpushtrap of { lbl_handler : label; }
+ | Lpoptrap
+ | Lraise of Lambda.raise_kind
+
+val has_fallthrough : instruction_desc -> bool
+val end_instr: instruction
+val instr_cons:
+ instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction
+val invert_test: Mach.test -> Mach.test
+
+type fundecl =
+ { fun_name: string;
+ fun_body: instruction;
+ fun_fast: bool;
+ fun_dbg : Debuginfo.t;
+ fun_spacetime_shape : Mach.spacetime_shape option;
+ fun_tailrec_entry_point_label : label;
+ fun_contains_calls: bool;
+ fun_num_stack_slots: int array;
+ fun_frame_required: bool;
+ fun_prologue_required: bool;
+ }
(**************************************************************************)
(* Transformation of Mach code into a list of pseudo-instructions. *)
-
-open Reg
-open Mach
-
-type label = Cmm.label
-
-type instruction =
- { mutable desc: instruction_desc;
- mutable next: instruction;
- arg: Reg.t array;
- res: Reg.t array;
- dbg: Debuginfo.t;
- live: Reg.Set.t }
-
-and instruction_desc =
- | Lprologue
- | Lend
- | Lop of operation
- | Lreloadretaddr
- | Lreturn
- | Llabel of label
- | Lbranch of label
- | Lcondbranch of test * label
- | Lcondbranch3 of label option * label option * label option
- | Lswitch of label array
- | Lentertrap
- | Lpushtrap of { lbl_handler : label; }
- | Lpoptrap
- | Lraise of Cmm.raise_kind
-
-let has_fallthrough = function
- | Lreturn | Lbranch _ | Lswitch _ | Lraise _
- | Lop Itailcall_ind _ | Lop (Itailcall_imm _) -> false
- | _ -> true
-
-type fundecl =
- { fun_name: string;
- fun_body: instruction;
- fun_fast: bool;
- fun_dbg : Debuginfo.t;
- fun_spacetime_shape : Mach.spacetime_shape option;
- fun_tailrec_entry_point_label : label;
- }
-
-(* Invert a test *)
-
-let invert_integer_test = function
- Isigned cmp -> Isigned(Cmm.negate_integer_comparison cmp)
- | Iunsigned cmp -> Iunsigned(Cmm.negate_integer_comparison cmp)
-
-let invert_test = function
- Itruetest -> Ifalsetest
- | Ifalsetest -> Itruetest
- | Iinttest(cmp) -> Iinttest(invert_integer_test cmp)
- | Iinttest_imm(cmp, n) -> Iinttest_imm(invert_integer_test cmp, n)
- | Ifloattest(cmp) -> Ifloattest(Cmm.negate_float_comparison cmp)
- | Ieventest -> Ioddtest
- | Ioddtest -> Ieventest
-
-(* The "end" instruction *)
-
-let rec end_instr =
- { desc = Lend;
- next = end_instr;
- arg = [||];
- res = [||];
- dbg = Debuginfo.none;
- live = Reg.Set.empty }
-
-(* Cons an instruction (live, debug empty) *)
-
-let instr_cons d a r n =
- { desc = d; next = n; arg = a; res = r;
- dbg = Debuginfo.none; live = Reg.Set.empty }
+open Linear
(* Cons a simple instruction (arg, res, live empty) *)
| Llabel lbl -> lbl
| _ -> -1
+
+(* Add pseudo-instruction Ladjust_trap_depth in front of a continuation
+ to notify assembler generation about updates to the stack as a result
+ of differences in exception trap depths.
+ The argument delta is the number of trap frames (not bytes). *)
+
+let rec adjust_trap_depth delta_traps next =
+ (* Simplify by merging and eliminating Ladjust_trap_depth instructions
+ whenever possible. *)
+ match next.desc with
+ | Ladjust_trap_depth { delta_traps = k } ->
+ adjust_trap_depth (delta_traps + k) next.next
+ | _ ->
+ if delta_traps = 0 then next
+ else cons_instr (Ladjust_trap_depth { delta_traps }) next
+
(* Discard all instructions up to the next label.
This function is to be called before adding a non-terminating
instruction. *)
let rec discard_dead_code n =
+ let adjust trap_depth =
+ adjust_trap_depth trap_depth (discard_dead_code n.next)
+ in
match n.desc with
Lend -> n
| Llabel _ -> n
-(* Do not discard Lpoptrap/Lpushtrap or Istackoffset instructions,
- as this may cause a stack imbalance later during assembler generation. *)
- | Lpoptrap | Lpushtrap _ -> n
- | Lop(Istackoffset _) -> n
+ (* Do not discard Lpoptrap/Lpushtrap/Ladjust_trap_depth
+ or Istackoffset instructions, as this may cause a stack imbalance
+ later during assembler generation. Replace them
+ with pseudo-instruction Ladjust_trap_depth with the corresponding
+ stack offset and eliminate dead instructions after them. *)
+ | Lpoptrap -> adjust (-1)
+ | Lpushtrap _ -> adjust (+1)
+ | Ladjust_trap_depth { delta_traps } -> adjust delta_traps
+ | Lop(Istackoffset _) ->
+ (* This dead instruction cannot be replaced by Ladjust_trap_depth,
+ because the units don't match: the argument of Istackoffset is in bytes,
+ whereas the argument of Ladjust_trap_depth is in trap frames,
+ and the size of trap frames is machine-dependant and therefore not
+ available here. *)
+ { n with next = discard_dead_code n.next; }
| _ -> discard_dead_code n.next
(*
snd (find_exit_label_try_depth k) = !try_depth
(* Linearize an instruction [i]: add it in front of the continuation [n] *)
-
-let rec linear i n =
- match i.Mach.desc with
- Iend -> n
- | Iop(Itailcall_ind _ | Itailcall_imm _ as op) ->
- if not Config.spacetime then
- copy_instr (Lop op) i (discard_dead_code n)
- else
- copy_instr (Lop op) i (linear i.Mach.next n)
- | Iop(Imove | Ireload | Ispill)
- when i.Mach.arg.(0).loc = i.Mach.res.(0).loc ->
- linear i.Mach.next n
- | Iop op ->
- copy_instr (Lop op) i (linear i.Mach.next n)
- | Ireturn ->
- let n1 = copy_instr Lreturn i (discard_dead_code n) in
- if !Proc.contains_calls
- then cons_instr Lreloadretaddr n1
- else n1
- | Iifthenelse(test, ifso, ifnot) ->
- let n1 = linear i.Mach.next n in
- begin match (ifso.Mach.desc, ifnot.Mach.desc, n1.desc) with
- Iend, _, Lbranch lbl ->
- copy_instr (Lcondbranch(test, lbl)) i (linear ifnot n1)
- | _, Iend, Lbranch lbl ->
- copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1)
- | Iexit nfail1, Iexit nfail2, _
- when is_next_catch nfail1 && local_exit nfail2 ->
- let lbl2 = find_exit_label nfail2 in
- copy_instr
- (Lcondbranch (invert_test test, lbl2)) i (linear ifso n1)
- | Iexit nfail, _, _ when local_exit nfail ->
- let n2 = linear ifnot n1
- and lbl = find_exit_label nfail in
- copy_instr (Lcondbranch(test, lbl)) i n2
- | _, Iexit nfail, _ when local_exit nfail ->
- let n2 = linear ifso n1 in
- let lbl = find_exit_label nfail in
- copy_instr (Lcondbranch(invert_test test, lbl)) i n2
- | Iend, _, _ ->
- let (lbl_end, n2) = get_label n1 in
- copy_instr (Lcondbranch(test, lbl_end)) i (linear ifnot n2)
- | _, Iend, _ ->
- let (lbl_end, n2) = get_label n1 in
- copy_instr (Lcondbranch(invert_test test, lbl_end)) i
- (linear ifso n2)
- | _, _, _ ->
- (* Should attempt branch prediction here *)
- let (lbl_end, n2) = get_label n1 in
- let (lbl_else, nelse) = get_label (linear ifnot n2) in
- copy_instr (Lcondbranch(invert_test test, lbl_else)) i
- (linear ifso (add_branch lbl_end nelse))
- end
- | Iswitch(index, cases) ->
- let lbl_cases = Array.make (Array.length cases) 0 in
- let (lbl_end, n1) = get_label(linear i.Mach.next n) in
- let n2 = ref (discard_dead_code n1) in
- for i = Array.length cases - 1 downto 0 do
- let (lbl_case, ncase) =
- get_label(linear cases.(i) (add_branch lbl_end !n2)) in
- lbl_cases.(i) <- lbl_case;
- n2 := discard_dead_code ncase
- done;
- (* Switches with 1 and 2 branches have been eliminated earlier.
- Here, we do something for switches with 3 branches. *)
- if Array.length index = 3 then begin
- let fallthrough_lbl = check_label !n2 in
- let find_label n =
- let lbl = lbl_cases.(index.(n)) in
- if lbl = fallthrough_lbl then None else Some lbl in
- copy_instr (Lcondbranch3(find_label 0, find_label 1, find_label 2))
- i !n2
- end else
- copy_instr (Lswitch(Array.map (fun n -> lbl_cases.(n)) index)) i !n2
- | Icatch(_rec_flag, handlers, body) ->
- let (lbl_end, n1) = get_label(linear i.Mach.next n) in
- (* CR mshinwell for pchambart:
- 1. rename "io"
- 2. Make sure the test cases cover the "Iend" cases too *)
- let labels_at_entry_to_handlers = List.map (fun (_nfail, handler) ->
- match handler.Mach.desc with
- | Iend -> lbl_end
- | _ -> Cmm.new_label ())
- handlers in
- let exit_label_add = List.map2
- (fun (nfail, _) lbl -> (nfail, (lbl, !try_depth)))
- handlers labels_at_entry_to_handlers in
- let previous_exit_label = !exit_label in
- exit_label := exit_label_add @ !exit_label;
- let n2 = List.fold_left2 (fun n (_nfail, handler) lbl_handler ->
- match handler.Mach.desc with
- | Iend -> n
- | _ -> cons_instr (Llabel lbl_handler)
- (linear handler (add_branch lbl_end n)))
- n1 handlers labels_at_entry_to_handlers
- in
- let n3 = linear body (add_branch lbl_end n2) in
- exit_label := previous_exit_label;
- n3
- | Iexit nfail ->
- let lbl, t = find_exit_label_try_depth nfail in
- (* We need to re-insert dummy pushtrap (which won't be executed),
- so as to preserve stack offset during assembler generation.
- It would make sense to have a special pseudo-instruction
- only to inform the later pass about this stack offset
- (corresponding to N traps).
- *)
- let lbl_dummy = lbl in
- let rec loop i tt =
- if t = tt then i
+let linear i n contains_calls =
+ let rec linear i n =
+ match i.Mach.desc with
+ Iend -> n
+ | Iop(Itailcall_ind _ | Itailcall_imm _ as op) ->
+ if not Config.spacetime then
+ copy_instr (Lop op) i (discard_dead_code n)
else
- loop (cons_instr (Lpushtrap { lbl_handler = lbl_dummy; }) i) (tt - 1)
- in
- let n1 = loop (linear i.Mach.next n) !try_depth in
- let rec loop i tt =
- if t = tt then i
- else loop (cons_instr Lpoptrap i) (tt - 1)
- in
- loop (add_branch lbl n1) !try_depth
- | Itrywith(body, handler) ->
- let (lbl_join, n1) = get_label (linear i.Mach.next n) in
- let (lbl_handler, n2) =
- get_label (cons_instr Lentertrap (linear handler n1))
- in
- incr try_depth;
- assert (i.Mach.arg = [| |] || Config.spacetime);
- let n3 = cons_instr (Lpushtrap { lbl_handler; })
- (linear body
- (cons_instr
- Lpoptrap
- (add_branch lbl_join n2))) in
- decr try_depth;
- n3
-
- | Iraise k ->
- copy_instr (Lraise k) i (discard_dead_code n)
-
-let add_prologue first_insn =
+ copy_instr (Lop op) i (linear i.Mach.next n)
+ | Iop(Imove | Ireload | Ispill)
+ when i.Mach.arg.(0).loc = i.Mach.res.(0).loc ->
+ linear i.Mach.next n
+ | Iop op ->
+ copy_instr (Lop op) i (linear i.Mach.next n)
+ | Ireturn ->
+ let n1 = copy_instr Lreturn i (discard_dead_code n) in
+ if contains_calls
+ then cons_instr Lreloadretaddr n1
+ else n1
+ | Iifthenelse(test, ifso, ifnot) ->
+ let n1 = linear i.Mach.next n in
+ begin match (ifso.Mach.desc, ifnot.Mach.desc, n1.desc) with
+ Iend, _, Lbranch lbl ->
+ copy_instr (Lcondbranch(test, lbl)) i (linear ifnot n1)
+ | _, Iend, Lbranch lbl ->
+ copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1)
+ | Iexit nfail1, Iexit nfail2, _
+ when is_next_catch nfail1 && local_exit nfail2 ->
+ let lbl2 = find_exit_label nfail2 in
+ copy_instr
+ (Lcondbranch (invert_test test, lbl2)) i (linear ifso n1)
+ | Iexit nfail, _, _ when local_exit nfail ->
+ let n2 = linear ifnot n1
+ and lbl = find_exit_label nfail in
+ copy_instr (Lcondbranch(test, lbl)) i n2
+ | _, Iexit nfail, _ when local_exit nfail ->
+ let n2 = linear ifso n1 in
+ let lbl = find_exit_label nfail in
+ copy_instr (Lcondbranch(invert_test test, lbl)) i n2
+ | Iend, _, _ ->
+ let (lbl_end, n2) = get_label n1 in
+ copy_instr (Lcondbranch(test, lbl_end)) i (linear ifnot n2)
+ | _, Iend, _ ->
+ let (lbl_end, n2) = get_label n1 in
+ copy_instr (Lcondbranch(invert_test test, lbl_end)) i
+ (linear ifso n2)
+ | _, _, _ ->
+ (* Should attempt branch prediction here *)
+ let (lbl_end, n2) = get_label n1 in
+ let (lbl_else, nelse) = get_label (linear ifnot n2) in
+ copy_instr (Lcondbranch(invert_test test, lbl_else)) i
+ (linear ifso (add_branch lbl_end nelse))
+ end
+ | Iswitch(index, cases) ->
+ let lbl_cases = Array.make (Array.length cases) 0 in
+ let (lbl_end, n1) = get_label(linear i.Mach.next n) in
+ let n2 = ref (discard_dead_code n1) in
+ for i = Array.length cases - 1 downto 0 do
+ let (lbl_case, ncase) =
+ get_label(linear cases.(i) (add_branch lbl_end !n2)) in
+ lbl_cases.(i) <- lbl_case;
+ n2 := discard_dead_code ncase
+ done;
+ (* Switches with 1 and 2 branches have been eliminated earlier.
+ Here, we do something for switches with 3 branches. *)
+ if Array.length index = 3 then begin
+ let fallthrough_lbl = check_label !n2 in
+ let find_label n =
+ let lbl = lbl_cases.(index.(n)) in
+ if lbl = fallthrough_lbl then None else Some lbl in
+ copy_instr (Lcondbranch3(find_label 0, find_label 1, find_label 2))
+ i !n2
+ end else
+ copy_instr (Lswitch(Array.map (fun n -> lbl_cases.(n)) index)) i !n2
+ | Icatch(_rec_flag, handlers, body) ->
+ let (lbl_end, n1) = get_label(linear i.Mach.next n) in
+ (* CR mshinwell for pchambart:
+ 1. rename "io"
+ 2. Make sure the test cases cover the "Iend" cases too *)
+ let labels_at_entry_to_handlers = List.map (fun (_nfail, handler) ->
+ match handler.Mach.desc with
+ | Iend -> lbl_end
+ | _ -> Cmm.new_label ())
+ handlers in
+ let exit_label_add = List.map2
+ (fun (nfail, _) lbl -> (nfail, (lbl, !try_depth)))
+ handlers labels_at_entry_to_handlers in
+ let previous_exit_label = !exit_label in
+ exit_label := exit_label_add @ !exit_label;
+ let n2 = List.fold_left2 (fun n (_nfail, handler) lbl_handler ->
+ match handler.Mach.desc with
+ | Iend -> n
+ | _ -> cons_instr (Llabel lbl_handler)
+ (linear handler (add_branch lbl_end n)))
+ n1 handlers labels_at_entry_to_handlers
+ in
+ let n3 = linear body (add_branch lbl_end n2) in
+ exit_label := previous_exit_label;
+ n3
+ | Iexit nfail ->
+ let lbl, t = find_exit_label_try_depth nfail in
+ assert (i.Mach.next.desc = Mach.Iend);
+ let delta_traps = !try_depth - t in
+ let n1 = adjust_trap_depth delta_traps n in
+ let rec loop i tt =
+ if t = tt then i
+ else loop (cons_instr Lpoptrap i) (tt - 1)
+ in
+ loop (add_branch lbl n1) !try_depth
+ | Itrywith(body, handler) ->
+ let (lbl_join, n1) = get_label (linear i.Mach.next n) in
+ let (lbl_handler, n2) =
+ get_label (cons_instr Lentertrap (linear handler n1))
+ in
+ incr try_depth;
+ assert (i.Mach.arg = [| |] || Config.spacetime);
+ let n3 = cons_instr (Lpushtrap { lbl_handler; })
+ (linear body
+ (cons_instr
+ Lpoptrap
+ (add_branch lbl_join n2))) in
+ decr try_depth;
+ n3
+
+ | Iraise k ->
+ copy_instr (Lraise k) i (discard_dead_code n)
+ in linear i n
+
+let add_prologue first_insn prologue_required =
(* The prologue needs to come after any [Iname_for_debugger] operations that
refer to parameters. (Such operations always come in a contiguous
block, cf. [Selectgen].) *)
(which is encoded with two zero words), then complaining about a
"hole in location list" (as it ignores any remaining list entries
after the misinterpreted entry). *)
- if Proc.prologue_required () then
+ if prologue_required then
let prologue =
{ desc = Lprologue;
next = tailrec_entry_point;
skip_naming_ops first_insn
let fundecl f =
+ let fun_prologue_required = Proc.prologue_required f in
+ let contains_calls = f.Mach.fun_contains_calls in
let fun_tailrec_entry_point_label, fun_body =
- add_prologue (linear f.Mach.fun_body end_instr)
+ add_prologue (linear f.Mach.fun_body end_instr contains_calls)
+ fun_prologue_required
in
{ fun_name = f.Mach.fun_name;
fun_body;
fun_dbg = f.Mach.fun_dbg;
fun_spacetime_shape = f.Mach.fun_spacetime_shape;
fun_tailrec_entry_point_label;
+ fun_contains_calls = contains_calls;
+ fun_num_stack_slots = f.Mach.fun_num_stack_slots;
+ fun_frame_required = Proc.frame_required f;
+ fun_prologue_required;
}
(**************************************************************************)
(* Transformation of Mach code into a list of pseudo-instructions. *)
-
-type label = Cmm.label
-
-type instruction =
- { mutable desc: instruction_desc;
- mutable next: instruction;
- arg: Reg.t array;
- res: Reg.t array;
- dbg: Debuginfo.t;
- live: Reg.Set.t }
-
-and instruction_desc =
- | Lprologue
- | Lend
- | Lop of Mach.operation
- | Lreloadretaddr
- | Lreturn
- | Llabel of label
- | Lbranch of label
- | Lcondbranch of Mach.test * label
- | Lcondbranch3 of label option * label option * label option
- | Lswitch of label array
- | Lentertrap
- | Lpushtrap of { lbl_handler : label; }
- | Lpoptrap
- | Lraise of Cmm.raise_kind
-
-val has_fallthrough : instruction_desc -> bool
-val end_instr: instruction
-val instr_cons:
- instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction
-val invert_test: Mach.test -> Mach.test
-
-type fundecl =
- { fun_name: string;
- fun_body: instruction;
- fun_fast: bool;
- fun_dbg : Debuginfo.t;
- fun_spacetime_shape : Mach.spacetime_shape option;
- fun_tailrec_entry_point_label : label;
- }
-
-val fundecl: Mach.fundecl -> fundecl
+val fundecl: Mach.fundecl -> Linear.fundecl
(* Allocate a new stack slot to the interval. *)
-let allocate_stack_slot i =
+let allocate_stack_slot num_stack_slots i =
let cl = Proc.register_class i.reg in
- let ss = Proc.num_stack_slots.(cl) in
- Proc.num_stack_slots.(cl) <- succ ss;
+ let ss = num_stack_slots.(cl) in
+ num_stack_slots.(cl) <- succ ss;
i.reg.loc <- Stack(Local ss);
i.reg.spill <- true
The interval is added to active. Raises Not_found if no free registers
left. *)
-let allocate_free_register i =
+let allocate_free_register num_stack_slots i =
begin match i.reg.loc, i.reg.spill with
Unknown, true ->
(* Allocate a stack slot for the already spilled interval *)
- allocate_stack_slot i
+ allocate_stack_slot num_stack_slots i
| Unknown, _ ->
(* We need to allocate a register to this interval somehow *)
let cl = Proc.register_class i.reg in
| _ -> ()
end
-let allocate_blocked_register i =
+let allocate_blocked_register num_stack_slots i =
let cl = Proc.register_class i.reg in
let ci = active.(cl) in
match ci.ci_active with
(* Remove the last interval from active and insert the current *)
ci.ci_active <- insert_interval_sorted i il;
(* Now get a new stack slot for the spilled register *)
- allocate_stack_slot ilast
+ allocate_stack_slot num_stack_slots ilast
| _ ->
(* Either the current interval is last and we have to spill it,
or there are no registers at all in the register class (i.e.
floating point class on i386). *)
- allocate_stack_slot i
+ allocate_stack_slot num_stack_slots i
-let walk_interval i =
+let walk_interval num_stack_slots i =
let pos = i.ibegin land (lnot 0x01) in
(* Release all intervals that have been expired at the current position *)
Array.iter
active;
try
(* Allocate free register (if any) *)
- allocate_free_register i
+ allocate_free_register num_stack_slots i
with
Not_found ->
(* No free register, need to decide which interval to spill *)
- allocate_blocked_register i
+ allocate_blocked_register num_stack_slots i
let allocate_registers() =
(* Initialize the stack slots and interval lists *)
ci_active = [];
ci_inactive = []
};
- Proc.num_stack_slots.(cl) <- 0
done;
+ (* Reset the stack slot counts *)
+ let num_stack_slots = Array.make Proc.num_register_classes 0 in
(* Add all fixed intervals (sorted by end position) *)
List.iter
(fun i ->
ci.ci_fixed <- insert_interval_sorted i ci.ci_fixed)
(Interval.all_fixed_intervals());
(* Walk all the intervals within the list *)
- List.iter walk_interval (Interval.all_intervals())
+ List.iter (walk_interval num_stack_slots) (Interval.all_intervals());
+ num_stack_slots
(* Linear scan register allocation. *)
-val allocate_registers: unit -> unit
+val allocate_registers: unit -> int array
| Icatch of Cmm.rec_flag * (int * instruction) list * instruction
| Iexit of int
| Itrywith of instruction * instruction
- | Iraise of Cmm.raise_kind
+ | Iraise of Lambda.raise_kind
type spacetime_part_of_shape =
| Direct_call_point of { callee : string; }
fun_codegen_options : Cmm.codegen_option list;
fun_dbg : Debuginfo.t;
fun_spacetime_shape : spacetime_shape option;
+ fun_num_stack_slots: int array;
+ fun_contains_calls: bool;
}
let rec dummy_instr =
| Icatch of Cmm.rec_flag * (int * instruction) list * instruction
| Iexit of int
| Itrywith of instruction * instruction
- | Iraise of Cmm.raise_kind
+ | Iraise of Lambda.raise_kind
type spacetime_part_of_shape =
| Direct_call_point of { callee : string; (* the symbol *) }
fun_codegen_options : Cmm.codegen_option list;
fun_dbg : Debuginfo.t;
fun_spacetime_shape : spacetime_shape option;
+ fun_num_stack_slots: int array;
+ fun_contains_calls: bool;
}
val dummy_instr: instruction
(* Emission of PowerPC assembly code *)
-open Misc
open Cmm
open Arch
open Proc
open Reg
open Mach
-open Linearize
+open Linear
open Emitaux
(* Reserved space at bottom of stack *)
let stack_offset = ref 0
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
let frame_size () =
let size =
reserved_stack_space +
let emit_reg r =
match r.loc with
| Reg r -> emit_string (register_name r)
- | _ -> fatal_error "Emit.emit_reg"
+ | _ -> Misc.fatal_error "Emit.emit_reg"
(* Output a stack reference *)
match r.loc with
| Stack s ->
let ofs = slot_offset s (register_class r) in `{emit_int ofs}(1)`
- | _ -> fatal_error "Emit.emit_stack"
+ | _ -> Misc.fatal_error "Emit.emit_stack"
(* Output the name of a symbol plus an optional offset *)
let function_name = ref ""
(* Entry point for tail recursive calls *)
let tailrec_entry_point = ref 0
-(* Label of glue code for calling the GC *)
-let call_gc_label = ref 0
+
+module IntSet = Stdlib.Set.Make(Stdlib.Int)
+module IntMap = Stdlib.Map.Make(Stdlib.Int)
+
+(* Labels of glue code for calling the GC.
+ There is one label per size allocated. *)
+let call_gc_labels : label IntMap.t ref = ref IntMap.empty
+ (* size -> label *)
+
+(* Return the label of the call GC point for the given size *)
+
+let label_for_call_gc ?label_after_call_gc sz =
+ match IntMap.find_opt sz !call_gc_labels with
+ | Some lbl -> lbl
+ | None ->
+ let lbl =
+ match label_after_call_gc with Some l -> l | None -> new_label() in
+ call_gc_labels := IntMap.add sz lbl !call_gc_labels;
+ lbl
+
+(* Number of call GC points *)
+
+let num_call_gc instr =
+ let rec loop i cg =
+ match i.desc with
+ | Lend -> IntSet.cardinal cg
+ | Lop (Ialloc {bytes = sz}) -> loop i.next (IntSet.add sz cg)
+ (* The following should never be seen, since this function is run
+ before branch relaxation. *)
+ | Lop (Ispecific (Ialloc_far _)) -> assert false
+ | _ -> loop i.next cg
+ in loop instr IntSet.empty
(* Relaxation of branches that exceed the span of a relative branch. *)
+ (if lbl2 = None then 0 else 1)
| Lswitch _ -> size 7 (5 + tocload_size()) (5 + tocload_size())
| Lentertrap -> size 0 (tocload_size()) (tocload_size())
+ | Ladjust_trap_depth _ -> 0
| Lpushtrap _ -> size 5 (4 + tocload_size()) (4 + tocload_size())
| Lpoptrap -> 2
| Lraise _ -> 6
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (Proc.prologue_required ());
+ assert (!prologue_required);
let n = frame_size() in
if n > 0 then begin
` addi 1, 1, {emit_int(-n)}\n`;
| {loc = Stack _; typ = Float}, {loc = Reg _} ->
` lfd {emit_reg dst}, {emit_stack src}\n`
| (_, _) ->
- fatal_error "Emit: Imove"
+ Misc.fatal_error "Emit: Imove"
end
| Lop(Iconst_int n) ->
if is_native_immediate n then
end else begin
match abi with
| ELF32 ->
- ` addis 28, 0, {emit_upper emit_symbol func}\n`;
- ` addi 28, 28, {emit_lower emit_symbol func}\n`;
+ ` addis 25, 0, {emit_upper emit_symbol func}\n`;
+ ` addi 25, 25, {emit_lower emit_symbol func}\n`;
emit_call "caml_c_call";
record_frame i.live false i.dbg
| ELF64v1 | ELF64v2 ->
- emit_tocload emit_gpr 28 (TocSym func);
+ emit_tocload emit_gpr 25 (TocSym func);
emit_call "caml_c_call";
record_frame i.live false i.dbg;
` nop\n`
| Double | Double_u -> "stfd" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
| Lop(Ialloc { bytes = n; label_after_call_gc; }) ->
- if !call_gc_label = 0 then begin
- match label_after_call_gc with
- | None -> call_gc_label := new_label ()
- | Some label -> call_gc_label := label
- end;
+ let call_gc_lbl = label_for_call_gc ?label_after_call_gc n in
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
- ` bltl {emit_label !call_gc_label}\n`;
+ ` bltl {emit_label call_gc_lbl}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live false Debuginfo.none
| Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; })) ->
- if !call_gc_label = 0 then begin
- match label_after_call_gc with
- | None -> call_gc_label := new_label ()
- | Some label -> call_gc_label := label
- end;
+ let call_gc_lbl = label_for_call_gc ?label_after_call_gc n in
let lbl = new_label() in
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` bge {emit_label lbl}\n`;
- ` bl {emit_label !call_gc_label}\n`;
+ ` bl {emit_label call_gc_lbl}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live false Debuginfo.none;
`{emit_label lbl}: addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
| ELF32 -> ()
| ELF64v1 | ELF64v2 -> emit_reload_toc()
end
+ | Ladjust_trap_depth { delta_traps } ->
+ adjust_stack_offset (trap_size * delta_traps)
| Lpushtrap { lbl_handler; } ->
begin match abi with
| ELF32 ->
adjust_stack_offset (-trap_size)
| Lraise k ->
begin match k with
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_regular ->
+ ` li 0, 0\n`;
+ let backtrace_pos =
+ Domainstate.(idx_of_field Domain_backtrace_pos)
+ in
+ begin match abi with
+ | ELF32 -> ` stw 0, {emit_int (backtrace_pos * 8)}(28)\n`
+ | _ -> ` std 0, {emit_int (backtrace_pos * 8)}(28)\n`
+ end;
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg;
emit_call_nop()
- | Cmm.Raise_notrace ->
+ | Lambda.Raise_reraise ->
+ emit_call "caml_raise_exn";
+ record_frame Reg.Set.empty true i.dbg;
+ emit_call_nop()
+ | Lambda.Raise_notrace ->
` {emit_string lg} 0, {emit_int trap_handler_offset}(29)\n`;
` mr 1, 29\n`;
` mtctr 0\n`;
function_name := fundecl.fun_name;
tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
stack_offset := 0;
- call_gc_label := 0;
+ call_gc_labels := IntMap.empty;
float_literals := [];
jumptables := []; jumptables_lbl := -1;
+ for i = 0 to Proc.num_register_classes - 1 do
+ num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+ done;
+ prologue_required := fundecl.fun_prologue_required;
+ contains_calls := fundecl.fun_contains_calls;
begin match abi with
| ELF32 ->
emit_string code_space;
end;
emit_debug_info fundecl.fun_dbg;
cfi_startproc();
- (* On this target, there is at most one "out of line" code block per
- function: a single "call GC" point. It comes immediately after the
- function's body. *)
- BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0;
+ let num_call_gc = num_call_gc fundecl.fun_body in
+ let max_out_of_line_code_offset = max (num_call_gc - 1) 0 in
+ BR.relax fundecl.fun_body ~max_out_of_line_code_offset;
emit_all fundecl.fun_body;
(* Emit the glue code to call the GC *)
- if !call_gc_label > 0 then begin
- `{emit_label !call_gc_label}:\n`;
+ assert (IntMap.cardinal !call_gc_labels = num_call_gc);
+ if num_call_gc > 0 then begin
+ (* Replace sizes by deltas with next size *)
+ let rec delta_encode = function
+ | (sz1, lbl1) :: ((sz2, _) :: _ as l) ->
+ (sz1 - sz2, lbl1) :: delta_encode l
+ | ([] | [(_,_)]) as l -> l in
+ (* Enumerate the GC call points by decreasing size. This is not
+ necessary for correctness, but it is nice for two reasons:
+ 1- all deltas are positive, making the generated code
+ easier to read, and
+ 2- smaller allocation sizes, which are more frequent, execute
+ fewer instructions before calling the GC. *)
+ let delta_lbl_list =
+ delta_encode (List.rev (IntMap.bindings !call_gc_labels)) in
+ List.iter
+ (fun (delta, lbl) ->
+ `{emit_label lbl}: addi 31, 31, {emit_int delta}\n`)
+ delta_lbl_list;
match abi with
| ELF32 ->
` b {emit_symbol "caml_call_gc"}\n`
3 - 10 function arguments and results
11 - 12 temporaries
13 pointer to small data area
- 14 - 28 general purpose, preserved by C
+ 14 - 27 general purpose, preserved by C
+ 28 domain state pointer
29 trap pointer
30 allocation limit
31 allocation pointer
let int_reg_name =
[| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";
"14"; "15"; "16"; "17"; "18"; "19"; "20"; "21";
- "22"; "23"; "24"; "25"; "26"; "27"; "28" |]
+ "22"; "23"; "24"; "25"; "26"; "27" |]
let float_reg_name =
[| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8";
| Val | Int | Addr -> 0
| Float -> 1
-let num_available_registers = [| 23; 31 |]
+let num_available_registers = [| 22; 31 |]
let first_available_register = [| 0; 100 |]
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
- let v = Array.make 23 Reg.dummy in
- for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; v
+ let v = Array.make 22 Reg.dummy in
+ for i = 0 to 21 do v.(i) <- Reg.at_location Int (Reg i) done; v
let hard_float_reg =
let v = Array.make 31 Reg.dummy in
let int_dwarf_reg_numbers =
[| 3; 4; 5; 6; 7; 8; 9; 10;
14; 15; 16; 17; 18; 19; 20; 21;
- 22; 23; 24; 25; 26; 27; 28;
+ 22; 23; 24; 25; 26; 27;
|]
let float_dwarf_reg_numbers =
(* Maximal register pressure *)
let safe_register_pressure = function
- Iextcall _ -> 15
- | _ -> 23
+ Iextcall _ -> 14
+ | _ -> 22
let max_register_pressure = function
- Iextcall _ -> [| 15; 18 |]
- | _ -> [| 23; 30 |]
+ Iextcall _ -> [| 14; 18 |]
+ | _ -> [| 22; 30 |]
(* Pure operations (without any side effect besides updating their result
registers). *)
(* Layout of the stack *)
-let num_stack_slots = [| 0; 0 |]
-let contains_calls = ref false
-
(* See [reserved_stack_space] in emit.mlp. *)
let reserved_stack_space_required () =
match abi with
| ELF32 -> false
| ELF64v1 | ELF64v2 -> true
-let frame_required () =
+let frame_required fd =
let is_elf32 =
match abi with
| ELF32 -> true
| ELF64v1 | ELF64v2 -> false
in
reserved_stack_space_required ()
- || num_stack_slots.(0) > 0
- || num_stack_slots.(1) > 0
- || (!contains_calls && is_elf32)
+ || fd.fun_num_stack_slots.(0) > 0
+ || fd.fun_num_stack_slots.(1) > 0
+ || (fd.fun_contains_calls && is_elf32)
-let prologue_required () =
- frame_required ()
+let prologue_required fd =
+ frame_required fd
(* Calling the assembler *)
(* Reloading for the PowerPC *)
-let fundecl f =
- (new Reloadgen.reload_generic)#fundecl f
+let fundecl f num_stack_slots =
+ (new Reloadgen.reload_generic)#fundecl f num_stack_slots
| Double -> "float64"
| Double_u -> "float64u"
-let raise_kind fmt = function
- | Raise_withtrace -> Format.fprintf fmt "raise_withtrace"
- | Raise_notrace -> Format.fprintf fmt "raise_notrace"
-
let phantom_defining_expr ppf defining_expr =
match defining_expr with
| Cphantom_const_int i -> Targetint.print ppf i
| Cfloatofint -> "floatofint"
| Cintoffloat -> "intoffloat"
| Ccmpf c -> Printf.sprintf "%sf" (float_comparison c)
- | Craise k -> Format.asprintf "%a%s" raise_kind k (Debuginfo.to_string d)
+ | Craise k -> Lambda.raise_kind k ^ Debuginfo.to_string d
| Ccheckbound -> "checkbound" ^ Debuginfo.to_string d
let rec expr ppf = function
val fundecl : formatter -> Cmm.fundecl -> unit
val data : formatter -> Cmm.data_item list -> unit
val phrase : formatter -> Cmm.phrase -> unit
-val raise_kind: formatter -> Cmm.raise_kind -> unit
open Format
open Mach
open Printmach
-open Linearize
+open Linear
let label ppf l =
Format.fprintf ppf "L%i" l
fprintf ppf "@,endswitch"
| Lentertrap ->
fprintf ppf "enter trap"
+ | Ladjust_trap_depth { delta_traps } ->
+ fprintf ppf "adjust trap depth by %d traps" delta_traps
| Lpushtrap { lbl_handler; } ->
fprintf ppf "push trap %a" label lbl_handler
| Lpoptrap ->
fprintf ppf "pop trap"
| Lraise k ->
- fprintf ppf "%a %a" Printcmm.raise_kind k reg i.arg.(0)
+ fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
end;
if not (Debuginfo.is_none i.dbg) then
fprintf ppf " %s" (Debuginfo.to_string i.dbg)
(* Pretty-printing of linearized machine code *)
open Format
-open Linearize
+open Linear
val instr: formatter -> instruction -> unit
val fundecl: formatter -> fundecl -> unit
| Ieventest -> fprintf ppf "%a & 1 == 0" reg arg.(0)
| Ioddtest -> fprintf ppf "%a & 1 == 1" reg arg.(0)
-let print_live = ref false
-
let operation op arg ppf res =
if Array.length res > 0 then fprintf ppf "%a := " regs res;
match op with
Arch.print_specific_operation reg op ppf arg
let rec instr ppf i =
- if !print_live then begin
+ if !Clflags.dump_live then begin
fprintf ppf "@[<1>{%a" regsetaddr i.live;
if Array.length i.arg > 0 then fprintf ppf "@ +@ %a" regs i.arg;
fprintf ppf "}@]@,";
fprintf ppf "@ and";
aux t
in
- aux handlers
+ aux handlers;
+ fprintf ppf "@;<0 -2>endcatch@]"
| Iexit i ->
fprintf ppf "exit(%d)" i
| Itrywith(body, handler) ->
fprintf ppf "@[<v 2>try@,%a@;<0 -2>with@,%a@;<0 -2>endtry@]"
instr body instr handler
| Iraise k ->
- fprintf ppf "%a %a" Printcmm.raise_kind k reg i.arg.(0)
+ fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
end;
if not (Debuginfo.is_none i.dbg) then
fprintf ppf "%s" (Debuginfo.to_string i.dbg);
val interferences: formatter -> unit -> unit
val intervals: formatter -> unit -> unit
val preferences: formatter -> unit -> unit
-
-val print_live: bool ref
val op_is_pure: Mach.operation -> bool
(* Info for laying out the stack frame *)
-val num_stack_slots: int array
-val contains_calls: bool ref
-val frame_required : unit -> bool
+val frame_required : Mach.fundecl -> bool
(* Function prologues *)
-val prologue_required : unit -> bool
+val prologue_required : Mach.fundecl -> bool
(** For a given register class, the DWARF register numbering for that class.
Given an allocated register with location [Reg n] and class [reg_class], the
(* Insert load/stores for pseudoregs that got assigned to stack locations. *)
-val fundecl: Mach.fundecl -> Mach.fundecl * bool
+val fundecl: Mach.fundecl -> int array -> Mach.fundecl * bool
instr_cons (Itrywith(self#reload body, self#reload handler)) [||] [||]
(self#reload i.next)
-method fundecl f =
+method fundecl f num_stack_slots =
redo_regalloc <- false;
let new_body = self#reload f.fun_body in
({fun_name = f.fun_name; fun_args = f.fun_args;
fun_body = new_body; fun_codegen_options = f.fun_codegen_options;
- fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape},
+ fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape;
+ fun_contains_calls = f.fun_contains_calls;
+ fun_num_stack_slots = Array.copy num_stack_slots;
+ },
redo_regalloc)
end
method makereg : Reg.t -> Reg.t
(* Can be overridden to avoid creating new registers of some class
(i.e. if all "registers" of that class are actually on stack) *)
- method fundecl : Mach.fundecl -> Mach.fundecl * bool
+ method fundecl : Mach.fundecl -> int array -> Mach.fundecl * bool
(* The entry point *)
end
open Proc
open Reg
open Mach
-open Linearize
+open Linear
open Emitaux
(* Layout of the stack. The stack is kept 8-aligned. *)
let stack_offset = ref 0
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
let frame_size () =
let size =
!stack_offset + (* Trap frame, outgoing parameters *)
match i.desc with
Lend -> ()
| Lprologue ->
- assert (Proc.prologue_required ());
+ assert (!prologue_required);
let n = frame_size() in
emit_stack_adjust n;
if !contains_calls then
gc_return_lbl = lbl_redo;
gc_frame_lbl = lbl_frame } :: !call_gc_sites;
`{emit_label lbl_redo}:`;
- ` lay %r11, {emit_int(-n)}(%r11)\n`;
- ` clgr %r11, %r10\n`;
- ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *)
- ` la {emit_reg i.res.(0)}, 8(%r11)\n`
+ ` lay {emit_reg i.res.(0)}, {emit_int(-n+8)}(%r11)\n`;
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` clg {emit_reg i.res.(0)}, {emit_int offset}(%r10)\n`;
+ ` brcl 12, {emit_label lbl_call_gc}\n`;
+ (* less than or equal *)
+ ` lay %r11, -8({emit_reg i.res.(0)})\n`
| Lop(Iintop Imulh) ->
(* Hacker's Delight section 8.3:
emit_string code_space
| Lentertrap ->
()
+ | Ladjust_trap_depth { delta_traps } ->
+ (* each trap occupies 16 bytes on the stack *)
+ let delta = 16 * delta_traps in
+ emit_stack_adjust delta;
+ stack_offset := !stack_offset + delta
| Lpushtrap { lbl_handler; } ->
stack_offset := !stack_offset + 16;
emit_stack_adjust 16;
stack_offset := !stack_offset - 16
| Lraise k ->
begin match k with
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_regular->
+ let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+ ` lghi %r1, 0\n`;
+ ` stg %r1, {emit_int offset}(%r10)\n`;
+ emit_call "caml_raise_exn";
+ `{record_frame Reg.Set.empty true i.dbg}\n`
+ | Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
`{record_frame Reg.Set.empty true i.dbg}\n`
- | Cmm.Raise_notrace ->
+ | Lambda.Raise_notrace ->
` lg %r1, 0(%r13)\n`;
` lgr %r15, %r13\n`;
` lg %r13, {emit_int size_addr}(%r15)\n`;
bound_error_call := 0;
float_literals := [];
int_literals := [];
+ for i = 0 to Proc.num_register_classes - 1 do
+ num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+ done;
+ prologue_required := fundecl.fun_prologue_required;
+ contains_calls := fundecl.fun_contains_calls;
` .globl {emit_symbol fundecl.fun_name}\n`;
emit_debug_info fundecl.fun_dbg;
` .type {emit_symbol fundecl.fun_name}, @function\n`;
2 - 5 function arguments and results (volatile)
6 function arguments and results (preserved by C)
7 - 9 general purpose, preserved by C
- 10 allocation limit (preserved by C)
+ 10 domain state pointer (preserved by C)
11 allocation pointer (preserved by C)
12 general purpose (preserved by C)
13 trap pointer (preserved by C)
(* Layout of the stack *)
-let num_stack_slots = [| 0; 0 |]
-let contains_calls = ref false
+let frame_required fd =
+ fd.fun_contains_calls
+ || fd.fun_num_stack_slots.(0) > 0
+ || fd.fun_num_stack_slots.(1) > 0
-let frame_required () =
- !contains_calls
- || num_stack_slots.(0) > 0
- || num_stack_slots.(1) > 0
-
-let prologue_required () =
- frame_required ()
+let prologue_required fd =
+ frame_required fd
(* Calling the assembler *)
end
-let fundecl f =
- (new reload)#fundecl f
+let fundecl f num_stack_slots =
+ (new reload)#fundecl f num_stack_slots
open Reg
open Mach
-open Linearize
+open Linear
(* Representation of the code DAG. *)
fun_dbg = f.fun_dbg;
fun_spacetime_shape = f.fun_spacetime_shape;
fun_tailrec_entry_point_label = f.fun_tailrec_entry_point_label;
+ fun_contains_calls = f.fun_contains_calls;
+ fun_num_stack_slots = f.fun_num_stack_slots;
+ fun_frame_required = f.fun_frame_required;
+ fun_prologue_required = f.fun_prologue_required;
}
end else
f
(* Instruction scheduling *)
type code_dag_node =
- { instr: Linearize.instruction;
+ { instr: Linear.instruction;
delay: int;
mutable sons: (code_dag_node * int) list;
mutable date: int;
method is_checkbound : Mach.operation -> bool
(* Says whether the given operation is a checkbound *)
(* Entry point *)
- method schedule_fundecl : Linearize.fundecl -> Linearize.fundecl
+ method schedule_fundecl : Linear.fundecl -> Linear.fundecl
end
val reset : unit -> unit
(* Instruction scheduling *)
-val fundecl: Linearize.fundecl -> Linearize.fundecl
+val fundecl: Linear.fundecl -> Linear.fundecl
(* Infer the size in bytes of the result of an expression whose evaluation
may be deferred (cf. [emit_parts]). *)
+let size_component = function
+ | Val | Addr -> Arch.size_addr
+ | Int -> Arch.size_int
+ | Float -> Arch.size_float
+
+let size_machtype mty =
+ let size = ref 0 in
+ for i = 0 to Array.length mty - 1 do
+ size := !size + size_component mty.(i)
+ done;
+ !size
+
let size_expr (env:environment) exp =
let rec size localenv = function
Cconst_int _ | Cconst_natint _ -> Arch.size_int
(Istore(Word_val, addr, is_assign), arg)
(* call marking methods, documented in selectgen.mli *)
+val contains_calls = ref false
method mark_call =
- Proc.contains_calls := true
+ contains_calls := true
method mark_tailcall = ()
self#mark_c_tailcall (* caml_ml_array_bound_error *)
| Iraise raise_kind ->
begin match raise_kind with
- | Cmm.Raise_notrace -> ()
- | Cmm.Raise_withtrace ->
+ | Lambda.Raise_notrace -> ()
+ | Lambda.Raise_regular
+ | Lambda.Raise_reraise ->
(* PR#6239 *)
(* caml_stash_backtrace; we #mark_call rather than
#mark_c_tailcall to get a good stack backtrace *)
method initial_env () = env_empty
method emit_fundecl f =
- Proc.contains_calls := false;
current_function_name := f.Cmm.fun_name;
let rargs =
List.map
fun_codegen_options = f.Cmm.fun_codegen_options;
fun_dbg = f.Cmm.fun_dbg;
fun_spacetime_shape;
+ fun_num_stack_slots = Array.make Proc.num_register_classes 0;
+ fun_contains_calls = !contains_calls;
}
end
method mark_call : unit
(* informs the code emitter that the current function is non-leaf:
it may perform a (non-tail) call; by default, sets
- [Proc.contains_calls := true] *)
+ [contains_calls := true] *)
method mark_tailcall : unit
(* informs the code emitter that the current function may end with
(which is the main purpose of tracking leaf functions) but some
architectures still need to ensure that the stack is properly
aligned when the C function is called. This is achieved by
- overloading this method to set [Proc.contains_calls := true] *)
+ overloading this method to set [contains_calls := true] *)
method mark_instr : Mach.instruction_desc -> unit
(* dispatches on instructions to call one of the marking function
val mutable instr_seq : Mach.instruction
+ (* [contains_calls] is declared as a reference instance variable,
+ instead of a mutable boolean instance variable,
+ because the traversal uses functional object copies. *)
+ val contains_calls : bool ref
end
val reset : unit -> unit
fun_codegen_options = f.fun_codegen_options;
fun_dbg = f.fun_dbg;
fun_spacetime_shape = f.fun_spacetime_shape;
+ fun_num_stack_slots = f.fun_num_stack_slots;
+ fun_contains_calls = f.fun_contains_calls;
}
fun_codegen_options = f.fun_codegen_options;
fun_dbg = f.fun_dbg;
fun_spacetime_shape = f.fun_spacetime_shape;
+ fun_num_stack_slots = f.fun_num_stack_slots;
+ fun_contains_calls = f.fun_contains_calls;
}
Cmm.expression
end
-module Make(I:I) : sig
+module Make(_:I) : sig
(* Compile stringswitch (arg,cases,d)
Note: cases should not contain string duplicates *)
val compile : Debuginfo.t -> Cmm.expression (* arg *)
-#!/bin/sh
+#!/bin/sh -e
#**************************************************************************
#* *
#* OCaml *
#* *
#**************************************************************************
-version=$(autoconf --version | sed -ne 's/^autoconf .* \([0-9][^ ]*\)$/\1/p')
-if [ "$version" != '2.69' ] ; then
- echo "autoconf 2.69 is required" >&2
- exit 1
-else
- # Remove the autom4te.cache directory to make sure we start in a clean state
- rm -rf autom4te.cache
- autoconf -W all,error
- # Some distros have this 2013 patch to autoconf, some don't...
- sed -i -e '/^runstatedir/d' \
- -e '/-runstatedir /,+8d' \
- -e '/--runstatedir=DIR/d' \
- -e 's/ runstatedir//' configure
-fi
+# Remove the autom4te.cache directory to make sure we start in a clean state
+rm -rf autom4te.cache
+
+autoconf --force --warnings=all,error
+
+# Allow pre-processing of configure arguments for Git check-outs
+# The sed call removes dra27's copyright on the whole configure script...
+sed -e '/^#[^!]/d' tools/git-dev-options.sh > configure.tmp
+
+# Some distros have the 2013 --runstatedir patch to autoconf (see
+# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=a197431414088a417b407b9b20583b2e8f7363bd
+# in the GNU autoconf repo), and some don't, so ensure its effects are
+# removed for CI consistency...
+# POSIX Notes
+# - sed -i without a backup file is not portable, hence configure.tmp
+# - GNU sed's /../,+8d becomes /../{N;..;d;} (and the last ; is important)
+sed -e '/^runstatedir/d' \
+ -e '/-runstatedir /{N;N;N;N;N;N;N;N;d;}' \
+ -e '/--runstatedir=DIR/d' \
+ -e 's/ runstatedir//' \
+ -e '1d' \
+ configure >> configure.tmp
+
+mv -f configure.tmp configure
+chmod +x configure
| VAL
| UNDERSCORE
| UIDENT of (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
# 22 "parsing/parser.ml"
)
| THEN
| STRUCT
| STRING of (
-# 658 "parsing/parser.mly"
+# 680 "parsing/parser.mly"
(string * string option)
# 34 "parsing/parser.ml"
)
| QUESTION
| PRIVATE
| PREFIXOP of (
-# 644 "parsing/parser.mly"
+# 666 "parsing/parser.mly"
(string)
# 50 "parsing/parser.ml"
)
| PERCENT
| OR
| OPTLABEL of (
-# 637 "parsing/parser.mly"
+# 659 "parsing/parser.mly"
(string)
# 60 "parsing/parser.ml"
)
| MATCH
| LPAREN
| LIDENT of (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
# 78 "parsing/parser.ml"
)
| LETOP of (
-# 602 "parsing/parser.mly"
+# 624 "parsing/parser.mly"
(string)
# 83 "parsing/parser.ml"
)
| LBRACE
| LAZY
| LABEL of (
-# 607 "parsing/parser.mly"
+# 629 "parsing/parser.mly"
(string)
# 103 "parsing/parser.ml"
)
| INT of (
-# 606 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string * char option)
# 108 "parsing/parser.ml"
)
| INITIALIZER
| INHERIT
| INFIXOP4 of (
-# 600 "parsing/parser.mly"
+# 622 "parsing/parser.mly"
(string)
# 115 "parsing/parser.ml"
)
| INFIXOP3 of (
-# 599 "parsing/parser.mly"
+# 621 "parsing/parser.mly"
(string)
# 120 "parsing/parser.ml"
)
| INFIXOP2 of (
-# 598 "parsing/parser.mly"
+# 620 "parsing/parser.mly"
(string)
# 125 "parsing/parser.ml"
)
| INFIXOP1 of (
-# 597 "parsing/parser.mly"
+# 619 "parsing/parser.mly"
(string)
# 130 "parsing/parser.ml"
)
| INFIXOP0 of (
-# 596 "parsing/parser.mly"
+# 618 "parsing/parser.mly"
(string)
# 135 "parsing/parser.ml"
)
| IN
| IF
| HASHOP of (
-# 655 "parsing/parser.mly"
+# 677 "parsing/parser.mly"
(string)
# 143 "parsing/parser.ml"
)
| FUN
| FOR
| FLOAT of (
-# 585 "parsing/parser.mly"
+# 607 "parsing/parser.mly"
(string * char option)
# 156 "parsing/parser.ml"
)
| ELSE
| DOWNTO
| DOTOP of (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
# 170 "parsing/parser.ml"
)
| DOT
| DONE
| DOCSTRING of (
-# 674 "parsing/parser.mly"
+# 696 "parsing/parser.mly"
(Docstrings.docstring)
# 178 "parsing/parser.ml"
)
| DO
| CONSTRAINT
| COMMENT of (
-# 673 "parsing/parser.mly"
+# 695 "parsing/parser.mly"
(string * Location.t)
# 185 "parsing/parser.ml"
)
| COLON
| CLASS
| CHAR of (
-# 565 "parsing/parser.mly"
+# 587 "parsing/parser.mly"
(char)
# 196 "parsing/parser.ml"
)
| ASSERT
| AS
| ANDOP of (
-# 603 "parsing/parser.mly"
+# 625 "parsing/parser.mly"
(string)
# 209 "parsing/parser.ml"
)
let not_expecting loc nonterm =
raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
+let dotop ~left ~right ~assign ~ext ~multi =
+ let assign = if assign then "<-" else "" in
+ let mid = if multi then ";.." else "" in
+ String.concat "" ["."; ext; left; mid; right; assign]
+let paren = "(",")"
+let brace = "{", "}"
+let bracket = "[", "]"
+let lident x = Lident x
+let ldot x y = Ldot(x,y)
let dotop_fun ~loc dotop =
(* We could use ghexp here, but sticking to mkexp for parser.mly
compatibility. TODO improve parser.mly *)
let string_set_fun ~loc =
ghexp ~loc (Pexp_ident(array_function ~loc "String" "set"))
+let multi_indices ~loc = function
+ | [a] -> false, a
+ | l -> true, mkexp ~loc (Pexp_array l)
+
let index_get ~loc get_fun array index =
let args = [Nolabel, array; Nolabel, index] in
mkexp ~loc (Pexp_apply(get_fun, args))
let array_get ~loc = index_get ~loc (array_get_fun ~loc)
let string_get ~loc = index_get ~loc (string_get_fun ~loc)
-let dotop_get ~loc dotop = index_get ~loc (dotop_fun ~loc dotop)
+let dotop_get ~loc path (left,right) ext array index =
+ let multi, index = multi_indices ~loc index in
+ index_get ~loc
+ (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false))
+ array index
let array_set ~loc = index_set ~loc (array_set_fun ~loc)
let string_set ~loc = index_set ~loc (string_set_fun ~loc)
-let dotop_set ~loc dotop = index_set ~loc (dotop_fun ~loc dotop)
+let dotop_set ~loc path (left,right) ext array index value=
+ let multi, index = multi_indices ~loc index in
+ index_set ~loc
+ (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true))
+ array index value
+
let bigarray_function ~loc str name =
ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name))
}
-# 756 "parsing/parser.ml"
+# 778 "parsing/parser.ml"
module Tables = struct
Obj.repr ()
and default_reduction =
- (16, "\000\000\000\000\000\000\002\219\002\218\002\217\002\216\002\215\002\170\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\002\204\002\203\002\202\002\201\002\200\002\199\002\198\002\197\002\196\002\169\002\195\002\194\002\193\002\192\002\191\002\190\002\189\002\188\002\187\002\186\002\185\002\184\002\183\002\182\002\181\002\180\002\179\002\178\002\177\002\176\002\175\002\174\002\173\002\172\002\171\000\000\000\000\000\"\000\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\027\001\146\001}\001\143\001\142\001\141\001\147\001\151\000\000\003\028\001\145\001\144\001~\001\149\001\140\001\139\001\138\001\137\001\136\001\134\001\150\001\148\000\000\000\000\000\000\001\129\000\000\000\000\001\131\000\000\000\000\001\133\001\155\001\152\001\135\001\127\001\153\001\154\000\000\003\026\003\025\003\024\000\000\000\000\000\016\001;\000\000\000\213\000\214\000\015\000\000\000\000\001\177\001\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\020\000\000\003\021\000\000\000\000\003\018\000\000\003\017\003\r\002\022\000\000\003\016\000\000\002\023\000\000\000\000\000\000\000\000\000f\000\000\000\000\000c\000\000\000\000\003\011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\180\001?\000\000\000\000\000\000\000\000\000\000\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000m\000_\000\000\000\000\000\000\000\000\0009\000\000\000\000\001@\000:\002j\000\000\001\r\000\000\000j\000\000\000\000\000\t\000\b\000\000\000\000\000\000\000\000\002\151\000\000\002I\002J\000\000\002G\002H\000\000\000\000\000\000\000\000\000\000\000\000\002\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\244\002\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000i\000\000\000\225\000\000\000\000\000\226\000\000\002L\002K\000\000\000\000\000\000\001\159\000\000\000\000\000\029\000\000\000\000\000\000\000\022\000\000\000\000\001f\000\017\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\001=\000\000\001<\000\000\003\012\000 \000\000\000\000\000\023\000\018\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\198\002 \002\018\000\000\000\026\000\000\002\019\000\000\000\000\001\156\000\000\000\000\000\000\000\n\000\000\000\000\000\000\000\011\002\245\000\000\002\246\000\000\000u\000\000\000\000\000\025\000\000\000\000\000\000\000\027\000\000\000\028\000\000\000\030\000\000\000\000\000\031\002\b\002\007\000\000\000\000\000\000\000\000\000\000\000\000\000]\000\000\002\156\000`\000l\000^\002\145\002\146\001\211\002\148\000\000\000\000\002\153\002F\002\155\000\000\000\000\000\000\002\162\002\159\000\000\000\000\000\000\001\208\001\194\000\000\000\000\000\000\000\000\001\198\000\000\001\193\000\000\001\210\002\168\000\000\001\209\001\201\000\000\000h\000\000\002\161\002\160\000\000\001\204\000\000\000\000\001\200\000\000\000\000\001\196\001\195\000\000\002\158\000\000\002N\002M\000\000\000\000\002*\002\157\002\154\000\000\000\000\000\000\000\000\001\161\001(\001)\002P\000\000\002Q\002O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\236\000\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202\000\201\000\199\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001X\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000\002\017\000\000\000\000\001W\000\000\000\000\000\000\001^\001]\001[\002\004\002\003\000\000\001V\001U\000\000\000\200\000\000\000\000\001I\000\000\000\000\001M\000\000\001\181\001\180\000\000\000\000\001\179\001\178\001L\001J\000\000\001N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\003\029\002s\002q\000\000\000\000\000\000\002~\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\144\000\000\002\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\222\000\000\000\000\000\000\000\000\000\000\000\000\000\234\001\221\000\235\000\000\000\000\000\000\001h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\000\000\000\230\000\000\000\000\000\000\002{\000\000\000\000\000\000\002V\002U\000\000\000\000\000\000\000\000\002}\002p\002o\000\000\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\179\000\000\000\000\000\000\000\164\000\000\000\000\000\000\0021\0020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\002\222\000\000\003\b\000\000\000\000\003\007\000\000\000\000\000\000\000\000\000\000\000\190\000\189\000\239\000\000\002\223\002\224\000\000\000\000\000k\000\000\002\163\002\147\000\000\002\166\000\000\002\165\002\164\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\000\000\002\n\000\000\000\000\000\000\000\242\000\000\000\000\000\241\000\240\000\000\000\000\000\000\000\000\000\245\000\000\000\000\000\244\000\000\001\207\000\000\000\000\001\218\000\000\000\000\001\220\000\000\000\000\001\216\001\215\001\213\001\214\000\000\000\000\000\000\000\000\000\000\001\019\000\012\000\247\000\000\000\000\000\000\002X\002W\000\000\000\000\002f\002e\000\000\000\000\000\000\000\000\002b\002a\000\000\000\000\002`\002_\000\000\000\000\002d\002c\002w\000\000\000\000\000\000\000\000\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002Z\000\000\000\000\000\000\000\000\000\000\002^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\006\002\005\000\163\000\000\002[\000\000\000\000\002Y\000\000\000\000\002]\000\000\000v\000w\000\000\000\000\000\000\000\000\000\134\000\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\193\000\194\000\127\000\000\000~\000\000\000\000\001+\000\000\001,\001*\002\012\000\000\000\000\002\r\002\011\000\000\000\000\000\000\000\000\000\000\000\254\000\000\000\000\000\255\000\000\000\000\000\166\000\000\001\001\001\000\000\000\000\000\002\127\002x\000\000\002\136\000\000\002\137\002\135\000\000\000\000\002$\000\000\002\141\000\000\002\142\002\140\000\000\000\000\002z\002y\000\000\000\000\000\000\001\244\000\000\001\175\000\000\000\000\000\000\002-\001\243\000\000\002\131\002\130\000\000\000\000\000\000\003\030\000\000\002h\000\000\002i\002g\000\000\002\129\002\128\000\000\000\000\000\000\002'\002v\000\000\002u\002t\000\000\002\139\002\138\000|\000\000\000\000\000\000\000\000\000{\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000y\000\000\001C\000\000\000\000\000\000\000a\000\000\000\000\000d\000\000\000b\000e\000\000\000\000\000\000\001`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\219\000\000\000\000\000q\000\000\000\222\000\220\000\000\000\000\000\000\000\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\000\000\000\000\001\242\000\000\000\000\000\246\001\173\000\000\000\232\000\233\000\253\000\000\000\000\000\000\000\000\000\000\001\188\001\182\000\000\001\187\000\000\001\185\000\000\001\186\000\000\001\183\000\000\000\000\001\184\000\000\001z\000\000\000\000\000\000\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\\\000\000\000\000\000\000\000\000\002\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\002\237\000\000\000\000\000\000\000\000\000\000\001\227\000\000\000\000\000\000\000\000\000\000\000\000\002\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001j\000\000\001\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\221\000\000\000\000\0022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\000\001{\000\000\000\000\000\000\000\000\000\000\000\000\002>\000\000\001P\000\000\001O\000\000\000\000\000\000\002=\000\000\001E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\011\002@\000\000\000\000\000\000\000\000\002C\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003&\000\000\000\000\000\000\000\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001e\000\000\001d\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\001\240\000\000\001\239\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000G\000\000\000\000\000\000\000H\000F\000\000\000K\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000J\000I\000\000\000D\000E\000\000\001\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\007\000Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000W\000\000\000Y\000X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\005\002D\0026\000\000\002<\0027\002B\002A\002?\001\022\000\000\0024\000\000\000\000\000\000\000\000\000\000\002\001\000\000\000\000\001\015\0028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001u\001q\000\000\000\000\000\000\000\207\000\000\000\000\001\247\002\001\000\000\000\000\001\017\001\245\001\246\000\000\000\000\000\000\000\000\000\000\001x\001t\001p\000\000\000\000\000\208\000\000\000\000\001w\001s\001o\001m\0029\0025\002E\001\021\001\224\0023\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\000\000\000\003#\000\000\000.\000\000\000\000\003)\000\000\003(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000\000\000\000\003\"\000\000\000\000\000\000\001\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001:\000\000\000\000\0018\0016\000\000\000/\000\000\000\000\003,\000\000\003+\000\000\000\000\000\000\0014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\0017\0015\000\000\000\000\000\000\0001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000+\000\000\000\000\000P\000\000\000)\000\250\000\000\0008\000%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000O\000N\000\000\000\000\000T\000S\000\000\000\000\001\163\000\000\000-\000\000\000\000\000\000\000,\000\000\000\000\000\000\0000\000\000\000R\000U\000\000\0002\0003\000\000\001\030\000\000\000\000\000\000\000\000\000\000\000\000\0006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\003\002\240\002\231\000\000\000\000\002\235\002\220\002\230\002\239\002\238\001\026\000\000\000\000\002\228\000\000\002\232\002\229\002\241\001\223\000\000\000\000\002\226\000\000\000\186\002\225\000\000\000\000\000\217\000\000\000\000\001\025\001\024\000\000\001G\001F\000\000\000\000\002\167\002\150\000\000\000;\000\000\000\000\000<\000\000\000\000\000\138\000\137\002\134\000\000\002\133\002\132\002r\000\000\000\000\000\000\000\000\002k\000\000\002m\000\000\002l\000\000\002S\002R\000\000\002T\000\000\000\000\000\130\000\000\000\000\001\232\000\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\000\000\002\234\001\252\001\253\001\248\001\250\001\249\001\251\000\000\000\000\000\000\000\185\000\000\000\000\002\001\000\000\000\211\000\000\000\000\000\000\000\000\002\233\000\000\000\183\000\000\000\000\000\000\000\000\0013\001-\000\000\000\000\001.\000\021\000\000\000\020\000\000\000\000\000\197\000\000\000\000\000\000\000\024\000\019\000\000\000\000\000\000\000\r\000\000\000\000\000\000\000\000\001v\001r\000\000\001n\003\n\000\000\002\001\000\000\000\210\000\000\000\000\000\000\000\000\002;\002\000\001\254\001\255\000\000\000\000\000\000\002\001\000\000\000\209\000\000\000\000\000\000\000\000\002:\000\000\001R\001Q\000\000\000\014\000\000\003$\000\000\000#\000\000\000\000\000\000\000\000\000\133\000\000\000\215\000\001\000\000\000\000\000\216\000\002\000\000\000\003\000\000\001\189\000\000\000\000\001\190\000\004\000\000\000\000\001\191\000\005\000\000\000\000\000\000\002\253\002\248\002\249\002\252\002\250\000\000\000\000\003\001\000\006\000\000\003\000\000\000\001 \000\000\000\000\002\254\000\000\002\255\000\000\000\000\000\000\000\000\001$\001%\000\000\000\000\001#\001\"\000\007\000\000\000\000\000\000\003\023\000\000\003\022")
+ (16, "\000\000\000\000\000\000\002\221\002\220\002\219\002\218\002\217\002\172\002\216\002\215\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\002\204\002\203\002\202\002\201\002\200\002\199\002\198\002\171\002\197\002\196\002\195\002\194\002\193\002\192\002\191\002\190\002\189\002\188\002\187\002\186\002\185\002\184\002\183\002\182\002\181\002\180\002\179\002\178\002\177\002\176\002\175\002\174\002\173\000\000\000\000\000\"\000\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\029\001\148\001\127\001\145\001\144\001\143\001\149\001\153\000\000\003\030\001\147\001\146\001\128\001\151\001\142\001\141\001\140\001\139\001\138\001\136\001\152\001\150\000\000\000\000\000\000\000\215\000\000\000\000\001\131\000\000\000\000\000\000\001\133\000\000\000\000\000\000\001\135\001\157\001\154\001\137\001\129\001\155\001\156\000\000\003\028\003\027\003\026\000\000\000\000\000\016\001;\000\000\000\211\000\212\000\015\000\000\000\000\001\179\001\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\000\000\003\023\000\000\000\000\003\020\000\000\003\019\003\015\002\024\000\000\003\018\000\000\002\025\000\000\000\000\000\000\000\000\000f\000\000\000\000\000c\000\000\000\000\003\r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\180\001?\000\000\000\000\000\000\000\000\000\000\000\000\002\003\000\000\000\000\000\000\000\000\000\000\000\000\000m\000_\000\000\000\000\000\000\000\000\0009\000\000\000\000\001@\000:\002l\000\000\001\r\000\000\000j\000\000\000\000\000\t\000\b\000\000\000\000\000\000\000\000\002\153\000\000\002K\002L\000\000\002I\002J\000\000\000\000\000\000\000\000\000\000\001P\001O\000\000\002\151\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\246\002\245\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000i\000\000\000\225\000\000\000\000\000\226\000\000\002N\002M\000\000\000\000\000\000\001\161\000\000\000\000\000\029\000\000\000\000\000\000\000\022\000\000\000\000\001h\000\017\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\001=\000\000\001<\000\000\003\014\000 \000\000\000\000\000\023\000\018\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\198\002\"\002\020\000\000\000\026\000\000\002\021\000\000\000\000\001\158\000\000\000\000\000\000\000\n\000\000\000\000\000\000\000\011\002\247\000\000\002\248\000\000\000u\000\000\000\000\000\025\000\000\000\000\000\000\000\027\000\000\000\028\000\000\000\030\000\000\000\000\000\031\002\n\002\t\000\000\000\000\000\000\000\000\000\000\000\000\000]\000\000\002\158\000`\000l\000^\002\147\002\148\001\213\002\150\000\000\000\000\002\155\002H\002\157\000\000\000\000\000\000\002\164\002\161\000\000\000\000\000\000\001\210\001\196\000\000\000\000\000\000\000\000\001\200\000\000\001\195\000\000\001\212\002\170\000\000\001\211\001\203\000\000\000h\000\000\002\163\002\162\000\000\001\206\000\000\000\000\001\202\000\000\000\000\001\198\001\197\000\000\002\160\000\000\002P\002O\000\000\000\000\002,\002\159\002\156\000\000\000\000\000\000\000\000\001\163\001(\001)\002R\000\000\002S\002Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\236\000\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\199\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\000\000\0034\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\000\000\000\002\019\000\000\000\000\001Y\000\000\000\000\000\000\001`\001_\001]\002\006\002\005\000\000\001X\001W\000\000\000\200\000\000\000\000\001I\000\000\000\000\001M\000\000\001\183\001\182\000\000\000\000\001\181\001\180\001L\001J\000\000\001N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002p\003\031\002u\002s\000\000\000\000\000\000\002\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\146\000\000\002\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\224\000\000\000\000\000\000\000\000\000\000\000\000\000\234\001\223\000\235\000\000\000\000\000\000\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\000\000\000\230\000\000\000\000\000\000\002}\000\000\000\000\000\000\002X\002W\000\000\000\000\000\000\000\000\002\127\002r\002q\000\000\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\179\000\000\000\000\000\000\000\164\000\000\000\000\000\000\0023\0022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\002\224\000\000\003\n\000\000\000\000\003\t\000\000\000\000\000\000\000\000\000\000\000\190\000\189\000\239\000\000\002\225\002\226\000\000\000\000\000k\000\000\002\165\002\149\000\000\002\168\000\000\002\167\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\000\000\002\012\000\000\000\000\000\000\000\242\000\000\000\000\000\241\000\240\000\000\000\000\000\000\000\000\000\245\000\000\000\000\000\244\000\000\001\209\000\000\000\000\001\220\000\000\000\000\001\222\000\000\000\000\001\218\001\217\001\215\001\216\000\000\000\000\000\000\000\000\000\000\001\019\000\012\000\247\000\000\000\000\000\000\002Z\002Y\000\000\000\000\002h\002g\000\000\000\000\000\000\000\000\002d\002c\000\000\000\000\002&\000\000\000\000\002b\002a\000\000\000\000\002f\002e\002y\000\000\000\000\000\000\000\000\000\000\002^\000\000\000\000\000\000\000\000\000\000\002\\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\b\002\007\000\163\000\000\002]\000\000\000\000\002[\000\000\000\000\002_\000\000\000v\000w\000\000\000\000\000\000\000\000\000\134\000\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\193\000\194\000\127\000\000\000~\000\000\000\000\001+\000\000\001,\001*\002\014\000\000\000\000\002\015\002\r\000\000\000\000\000\000\000\000\000\000\000\254\000\000\000\000\000\255\000\000\000\000\000\166\000\000\001\001\001\000\000\000\000\000\002\129\002z\000\000\002\138\000\000\002\139\002\137\000\000\002\143\000\000\002\144\002\142\000\000\000\000\002|\002{\000\000\000\000\000\000\001\246\000\000\001\177\000\000\000\000\000\000\002/\001\245\000\000\002\133\002\132\000\000\000\000\000\000\003 \000\000\002j\000\000\002k\002i\000\000\002\131\002\130\000\000\000\000\000\000\002)\002x\000\000\002w\002v\000\000\002\141\002\140\000|\000\000\000\000\000\000\000\000\000{\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000y\000\000\001C\000\000\000\000\000\000\000a\000\000\000\000\000d\000\000\000b\000e\000\000\000\000\000\000\001b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\219\000\000\000\000\000q\000\000\000\222\000\220\000\000\000\000\000\000\000\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\000\000\000\000\001\244\000\000\000\000\000\246\001\175\000\000\000\232\000\233\000\253\000\000\000\000\000\000\000\000\000\000\001\190\001\184\000\000\001\189\000\000\001\187\000\000\001\188\000\000\001\185\000\000\000\000\001\186\000\000\001|\000\000\000\000\000\000\001{\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\002\239\000\000\000\000\002\238\000\000\000\000\000\000\000\000\000\000\001\229\000\000\000\000\000\000\000\000\000\000\000\000\002\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001l\000\000\001\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\223\000\000\000\000\0024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\000\001}\000\000\000\000\000\000\000\000\000\000\001R\000\000\001Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\011\002B\000\000\000\000\000\000\002@\000\000\000\000\000\000\002?\000\000\001E\000\000\000\000\000\000\000\000\002E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003(\000\000\000\000\000\000\000\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001g\000\000\001f\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\001\242\000\000\001\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000G\000\000\000\000\000\000\000H\000F\000\000\000K\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000J\000I\000\000\000D\000E\000\000\001\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\007\000Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000W\000\000\000Y\000X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\005\002F\0028\000\000\002>\0029\002D\002C\002A\001\022\000\000\0026\000\000\000\000\000\000\000\000\000\000\002\003\000\000\000\000\001\015\002:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\001s\000\000\000\000\000\000\000\205\000\000\000\000\001\249\002\003\000\000\000\000\001\017\001\247\001\248\000\000\000\000\000\000\000\000\000\000\001z\001v\001r\000\000\000\000\000\206\000\000\000\000\001y\001u\001q\001o\002;\0027\002G\001\021\001\226\0025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003#\000\000\000\000\003%\000\000\000.\000\000\000\000\003+\000\000\003*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\"\000\000\000\000\003$\000\000\000\000\000\000\001\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001:\000\000\000\000\0018\0016\000\000\000/\000\000\000\000\003.\000\000\003-\000\000\000\000\000\000\0014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\0017\0015\000\000\000\000\000\000\0001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000+\000\000\000\000\000P\000\000\000)\000\250\000\000\0008\000%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000O\000N\000\000\000\000\000T\000S\000\000\000\000\001\165\000\000\000-\000\000\000\000\000\000\000,\000\000\000\000\000\000\0000\000\000\000R\000U\000\000\0002\0003\000\000\001\030\000\000\000\000\000\000\000\000\000\000\000\000\0006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\003\002\242\002\233\000\000\000\000\002\237\002\222\002\232\002\241\002\240\001\026\000\000\000\000\002\230\000\000\002\234\002\231\002\243\001\225\000\000\000\000\002\228\000\000\000\186\002\227\000\000\000\000\000\217\000\000\000\000\001\025\001\024\000\000\001G\001F\000\000\000\000\002\169\002\152\000\000\000;\000\000\000\000\000<\000\000\000\000\000\138\000\137\002\136\000\000\002\135\002\134\002t\000\000\000\000\000\000\000\000\002m\000\000\002o\000\000\002n\000\000\002U\002T\000\000\002V\000\000\000\000\000\130\000\000\000\000\001\234\000\210\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\000\000\002\236\001\254\001\255\001\250\001\252\001\251\001\253\000\000\000\000\000\000\000\185\000\000\000\000\002\003\000\000\000\209\000\000\000\000\000\000\000\000\002\235\000\000\000\183\000\000\000\000\000\000\000\000\0013\001-\000\000\000\000\001.\000\021\000\000\000\020\000\000\000\000\000\197\000\000\000\000\000\000\000\024\000\019\000\000\000\000\000\000\000\r\000\000\000\000\000\000\000\000\001x\001t\000\000\001p\003\012\000\000\002\003\000\000\000\208\000\000\000\000\000\000\000\000\002=\002\002\002\000\002\001\000\000\000\000\000\000\002\003\000\000\000\207\000\000\000\000\000\000\000\000\002<\000\000\001T\001S\000\000\000\014\000\000\003&\000\000\000#\000\000\000\000\000\000\000\000\000\133\000\000\000\213\000\001\000\000\000\000\000\216\000\002\000\000\000\003\000\000\001\191\000\000\000\000\001\192\000\004\000\000\000\000\001\193\000\005\000\000\000\000\000\000\002\255\002\250\002\251\002\254\002\252\000\000\000\000\003\003\000\006\000\000\003\002\000\000\001 \000\000\000\000\003\000\000\000\003\001\000\000\000\000\000\000\000\000\001$\001%\000\000\000\000\001#\001\"\000\007\000\000\000\000\000\000\003\025\000\000\003\024")
and error =
- (122, "'\225 \022*\183\204\207@P?\144\000\0148\b\216@\005\194\141\241'\208\004\015\128\000\001\142\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\254\182mf\235\252\205\255\005G\248\132A\231\129\247\217\016\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|I\244\001\003\224\000\000c\129\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\031\128\176\144\000\015\136\128A\000@\162\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\002\012\\ \000\016\000\000\000\000\000\001\000@\001\000\131\004\016\000\000@\000\000\000\000\000@\016\000\000 \193\004\000\000\016\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\168\000\131\t!\192\001\016\007a\002 \004\132\128 \000 \128\bP\000@\001\136\000\b\000! \b\000\b \002\016\000\016\000b\000\002\000\0000\000\b0A0\001\000\000\000\000\000\000\000\000\012\000\002\b\016L\000@\000\000\000\000\000\000\000\003\000\000\130\004\019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\b \0010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\130\000\016\000\000\000\000\000\000\000\000\000\000\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000 \128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\b \128\b`\000@\001\216\004H\001\000\200\0008\016\000\197\194\128\001\000\128 \000\016\bH\002 \003\b$\135\000\004@\025\132A\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000\192@\003\023\n\000\004\002\000\128\000@\000\192\0020\016 \197\194\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\002\236\000\131%!\192\193\018\007`\022a\022\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\b\000\0001p\128\000H\000\b\000\000\000\004\000@\000\000\004\000\000\000\018\000\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\bP\t\024\000\004\144\135\003\000H\004\132H\000A\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\012\016L\000@\000\000\000\000\000\000\000\003\000\000\130\004\019\000\016\000\000\000\000\000\000\000\000\192\000 \129\004\192\000\000\000\000\000\000\000\000\0000\000\b \0010\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\b \128H`\000D\001\216\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128@\128\017\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\b\216@\005\194\141\241'\208\004\015\128\000\001\142\0026\016\001`\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\001\000 0H\228\000\000`\000\000c\000\004\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\001\000\016\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235w\246o\191\223\255\240t\255\152\132\014y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\024\129\248\171}H\244\249\139\228\016\006k\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\b\016\002\003\004\142@\000\006\000\000\0060\b\216@\005\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\001\000\n\bP0\000\000\b\004\000\000!\000\000\000\000\002\130\020\012\000\000\002\001\000\000\b@\000\000\000\000\160\132\003\000\000\000\128@\000\000\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\134 ~\002\206R->2\027\004\001\146\203\128\000\b\000\000\000\000\000@\000\004\000\000\000\000 @\000\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\002\159\132\128X\170\2233}\001@\254 \0008\224\167\225 \022*\183\204\207@P?\136\000\0148)\248H\133\138\173\2433\208\020\015\230\000\003\142\000\016 \000\016\000 A\000\000\004\000\000\000\002\000\004\b\000\004\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\000P \000\000\000 @\000\000\004\000\000\000\000\000\141\132\000X(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000\\(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241#\208\004\015\128\000\001\142\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\200@\000\128\004\193\"\208\001\001\160\000\001D\0002\016 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\016\000\192\000\176\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\003\000\000\192@\003\023\b\000\004\000\000\000\000P\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\236\000\131!!\192\193\018\007`\022!\022\003\000\000\192@\003\023\b\000\004\000\000\000\000\0001 .\192\b2\018\028\012\017 v\001b\017`0\000\b\000\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000 \000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001`.\192\b2R\028\012\017 v\001b\017`\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000 \000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001`.\192\b2R\028\012\017 v\001b\017`0\000\b\000\0001p\128\000@\000\000\000\000\003\022\002\236\000\131%!\192\193\018\007`\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000@\000\002\000\000\000\001\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\b\000\000\000\000@\000\002\000\000\000\001\002\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\b\000\000\000\004H\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@\000\002\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\236\000\131!!\192\193\018\007`\022!\020\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\128\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000D\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\0002\016\0000\0010I\164\000@`\000\000A\000\012\132\000\b\000L\018i\000\016\024\000\000\016@\003!\000\002\000\019\004\138@\004\006\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\164m\t\001L\018k\000\016\025B\006\213P\000\001\000\002\000\016\000\000@\000\004\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027B@S\004\155\192\004\006\208A\181T\000@\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\128 \0010H\180\000@h\000\002A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\192\004\193&\208\001\001\160\000\001\004\0002\016\000 \0010I\180\000@h\000\000A\000\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\004\000\001\000\000\000\005\000\019\020@\012\132\000\b\000L\018-\000\016\026\000\000\016@\144\000\027\000\000@\000\016\000\000\000P\0011D \200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000l\000\001\000\000@\000\000\001@\004\197\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\200F\192\128\020\193&\208\001\001\180\000MU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027\002\000S\004\155@\004\006\208\0015T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\004\000\001\000\000\000\005\000\019\020B\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\000\006\192\000\016\000\004\000\000\000\020\000LQ\b\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\128\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001 \000\000\000\001\000\000\000\000\000\018\020B\012\132\b\b\000L\018-\000\016\026\000\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000D\000\000\000\000@\000\000\000\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000 \192\000@\000\000@\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\004$\0010I\172\000@d\000\019E@\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\016\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000 \000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\012\132\016\012\130L\018m\000\016\026\000\000\016@\001\002\000\001\000\002\004\016\000\000@\000\000\000 \000@\128\000@\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\002\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\0000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012\004\135\000\004@\029\128\b\128\016\002\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000\130\000\019\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\004\000\000\012\000\003\129\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\012H\002\160\002\012\004\135\000\004@\029\128\b\128P\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\196\128*\000 \192Hp\000D\001\216\004\136\0051 \n\128\b0\018\028\000\017\000v\001\"\000@0\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\0001 \n\128\b0\018\028\000\017\000v\001\"\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@@\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\004@\029\132\b\128\016\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\017\000v\016\"\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\003\018\000\168\000\131\t!\192\001\016\007a\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004 \000\000\000\000\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\025\000v\000&\000@P \128\000\000 @\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\002\000\016\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\192\000\b\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\025\000v\016&\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\128\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\b\216@\133\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\002\000\000@\000\000\000\000\000\000\004\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000H@\004\000\128\193#\144\000\001\128\000\001\140\012\000\001\016\000\000\000\000\000\000\192\004\020\t\000\000\141\132\000\\(\223\018}\000@\248 \000\024\224#a\000\022\n7\196\159@\016>\b\000\0068\b\216@\005\130\141\241#\208\004\015\130\000\001\142\000\018\016\001\016 0I\228\000\000`\000\000c\000\004\132\000@\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\142@\000\006\000\000\0060\000H@\004\000\128\193#\144\000\001\128\000\001\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\181\207\239\254\216}\246\223\255|\004\000\000\000\000\012\0028\000\000\000\000\000\000\000\163a\136\031\138\183\212\143O\152\190A\000f\186\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\129`\163|H\244\001\003\224\000\000c\130\141\132 X(\223\018=\000@\248\000\000\024\224\129\002\000\001\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000@\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\b\022\n7\196\143@\016>\000\000\0068(\216B\005\130\141\241#\208\004\015\128\000\001\142\b2\016\128 \0010H\180\000@`\000\000A\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\141\132\000\\(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0002\016\0000\0010I\180\000@h\000\000E\000\012\132\000\b\000L\018m\000\016\026\000\000\017@\003!\000\002\000\019\004\139@\004\006\128\000\004P\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\001\000\000\000\000\004\000\001\000\000\000\000\000\018\004@\141\132\000X(\223\018=\000@\248\000\000\024\224\003)\000C@\019\004\154\192\004\006\000\000\004\016\000\202@\016\144\004\193&\176\001\001\128\000\001\004\0002\144\004$\0010H\172\000@`\000\000A\000\b\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\128\000\000\000\001\000\000\000\004\000\019\004@\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000@\000\000\000\000\000\002\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b:\024\129\248\0119H\180\248\200l\016\006K,\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\001\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@#a\000\022\n7\196\143@\016>\000\000\0068\000\200@\000\192\004\193&\208\001\001\160\000\001\004\0002\016\000 \0010I\180\000@h\000\000A\000\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\016\000\000\000@\001 D\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\018\016\001\016 0I\228\000\000`\000\000c\000\004\132\000@\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\142@\000\006\000\000\00601%.\195\232>\022\028\015\251`w\219~p\240\018\016\001\000 0H\228\000\000`\000\000c\003\022\246\237\127\139\237s\251\255\182\031}\183\255\223\000\000\000\000\000\002\000\n\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0026\016\001`\163|H\244\001\003\224\000\000c\131\022\246\237\127\139\237s\251\255\182\031}\183\255\207\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\00601on\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\003\000\n\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\022\246\237\127\139\237s\251\255\182\031}\183\255\207\196\148\187\015\160\248Xp?\237\129\223m\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\215?\191\251a\247\219\127\252\252IK\176\250\015\133\135\003\254\216\029\246\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\253n\199\234\191\247?\223\253o\247\139\127\254\247\223dB\011\248\212\000\019\007\007\184\226\192\160\208\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2402\016\000 \0010I\180\000@`\000\000A\000\012\132\000\b\000L\018-\000\016\024\000\000\016@\003)\000B@\019\004\154\192\004\006@\001\180T \232b\007\224,\229\"\211\227!\176@\025,\176\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\138\192\004\006@\000\148\016\000\200@\000\128\004\193\"\144\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000d\000\000\000\000@\000\000\001\000\000\000\000\131\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\001\000\000\000\004\000\b\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\128\000\025\000\000\000\000\016\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\004$\0010H\172\000@d\000\tA\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\016\000\000\000\000\0010D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\128\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\019\004@\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D \200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\131!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\018\004B\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\001\000\000\000\004\000\018\004B\018\000\136\000\130\001!\128\001\144\006`\000 \004\132\128\"\000 \136H`0d\001\152\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b\016\248\003\001\001\000\248\b\004\000\022\b\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\136\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\130\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\129\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\00601on\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\136\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b \248\003\001\001\000\248\b\004\000\022\b\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\129\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192@\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\130\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068 \000 C\224\012\004\004\003\224 \016\000X <[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\136\015\1280\016\016\015\128\128@\001`\128\241on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068 \000 \131\224\012\004\004\003\224 \016\000X <[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b\016\248\003\001\001\000\248\b\004\000\022\b\015\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\252[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\241on\215\248\190\215?\191\251a\247\219\127\253\252[\219\181\254/\181\207\239\254X}\226\223\255<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\b\128\248\003\001\001\000\248\b\004\000\022\b\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068 \000 \131\224\012\004\004\003\224 \016\000X 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\129\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\014\134 ~\002\206R->2\027\004\001\146\203\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\004$\0050H\172\000@`\000\001A\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000A\000\000\000\004\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000@\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\018\004@\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\1306\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\132 @\b\012\0189\000\000\024\000\000\024\192\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\146\015\1280\016\016\015\128\128@\001a\128\232\216@\133\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\bX(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\0060\016\000\000\000\000\000\000\000\000\003\000\000P\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\004\000\000\000\002\000\000D\000\000\000\000\000\000\000\000\000\000\000\000\129\000\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\192\000\020\000\000\000\004\000\000\000\000\012\0028\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\012\000A@\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\176\250\015\133\135\003\254\216\029\246\223\156<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\016\248\003\001\001\000\248\024\004\000\022\b\014\000\000@\000\000\000\000\000\000\004\000\000\000\000\000\128\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016 \000\000\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\002\000\016\000 \000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\001\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\000 \130Hp\000d\001\152\000\b\001\000@\016\000\000 \193\000\000\000\016\000\000\000\000\004\000\000\000\000\004\000\001\000\000\000\004\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\000 \130Hp\000d\001\152\000\b\001\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\016\000 \001\128\000\000 \000\000\000\000\004\128\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\002\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\016\000 \000\000\000\016\000\000\192\000 \000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\004@\000\000\000\004\000\000 \000\000\000\001\000\000\001\016\000\000\000\001\000\000\000\000\000\000\000\000\000\000D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\001\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\001\000\000\b\000\000\000\000@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000 \000\000\197\194\000\001\000\000\000\000\000\bX\n \002\012\020\135\000\006@\025\128@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\000 \129Hp\000d\001\152\004\bA\000\192\000 \000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\000 \129Hp\000d\001\152\004\bA!`(\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\001\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016@ \0010I\180\000@`\000\000A\000\012\132\016\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\128\000\001\004\bH\002 \002\b\004\134\000\006@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\000\b\000L\018-\000\016\026\000\000\017@\196\148\187\015\160\248Xp?\229\129\222-\249\195\224\000\"\003\224\012\004\004\003\224 \016\000| 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\016\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\002\018\000\136\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\001\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\016\000\016\001\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000v\000\002\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\136\000\131\001!\192\001\016\006`\000 \000\132\128\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000@\000\000\000\001\000\000\000\000\000\000\000\000\004\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000! \b\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000! \b\128\b \018\024\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\004\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\018\018\000\136\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\159\132\137X\170\2233=\001@\254\000\000x\224\003!\000\002\000\019\004\139@\004\006\128\000\004\016\004\000\000\128\000\000\000\004\000\000\000\000\000H\017\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\000\016 \000\016\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000! \b\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\003\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\bH\018 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\016\000 \001\128\000\000 \000\000\000\000\004\128\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000! \b\128\012 \018\028\000\017\000v\000\006\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\128\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\016\002\016\000\016\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\000 \128Hp\000D\001\152\000\b\000! \b\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\192\001\016\006`\000 \000\132\128\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000x\002,\006\b1\244\128\004@\024\000\000\128\002\018\000\136\000\130\000!\000\001\000\006`\000 \000\001\000\000\001\000\000\000\016\000\000\000\000\000\000 \000@\000\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \130\b`\000@\001\152@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \130\b`\000@\001\152@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000@\016\000\000\001\000\000\000\000\000\000\000\000\004\000\016\000\000\000\000@\000\000\000\000\000\000\000\001\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\020\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 @\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\002\018\000\136\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\018\018\000\136\000\130\000!\000\001\000\006`\000 \004\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\000 \192\bp\000@\001\152\000\b\001! \b\128\b \002\016\000\016\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@\001\000\131\004\016\000\000@\000\000\000\000\000@\016\000\000 \193\004\000\000\016\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\136\000\131\000!\192\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \001\128\000\000 \000\000\000\000\004\128\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\0000\128\bp\000@\001\152\000\024\000\002 \000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\016\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\b\000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\b\001D\b\000\000\000\000\000\000\000!\000\000\000\000\002\130\020\004\000\000\002\001\000\000\b@\000\000\000\000\160\132\001\000\000\000\128@\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\132\001\000\000\000\128@\000\000 \000\000\000\004\004\000@\000\000\000\000\000\000\000\b\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\bp\016\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\016\001\000\000\000\000\000\000\000\000 \000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000 \000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000!\000\000\000\000\002\002\028\012\000\000\018\001\000\000\b@\000\000\000\000\128\134\001\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000H\004\000\000\000@\000\000\002\000Q\006\000\000\000\000\000\000\000\000\016\000\000\000\128\020@\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000@\000\000\002\000Q\002\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\000\000\000\016\000\000\000\000\b\000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\001\004@\029\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\000\000\128\020@\128\000\000\000\000\000\000\002\018\000\168\000\130!!\192A\016\007`\016 \004\132\000\000\000\000\b\bp\016\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001q\128\000@\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\b@\000\000\000\000\128\135\003\000\000\000\128@\000\002\016\000\000\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`\016\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\000@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\b\001D\b\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\1285p\128\000@\000\000\000\000\002\022\002\168\000\131\004!\192\001\016\007`\000`\004\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\012\004\1285p\128\000@\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\001@\000\000\002\000\000\000\000\016\000\000\000\000\001\000@\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\012\004\1285p\128\000@\000\000\000\000\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\004\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\133\128\170\000 \193\bp\000D\001\216\000\b\001!`*\128\b0B\028\000\017\000v\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\168\000\130\000!\192\001\000\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128\000\128\018\018\000\136\000\130\000!\000\001\000\006`\000 \004\b\000\000\000\000\001\000\024\000\000\000\000\000\000\000\002\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128\000\128\018\018\000\136\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128\b@\000@\001\152\000\b\001\000\128\000 \128\004\192\004\000\000\000\000\000\000\000\000 \000\b \0010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\216\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128@\128\018\018\000\136\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\132\000\004\000\025\128\000\128\016\b\000\002\b\000L\000@\000\000\000\000\000\000\000\002\000\000\130\000\019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\012\128\003\129\000\012\\(\000\016\b\002\000\001\000\003\000\002\192@\003\023\b\000\004\000\000\000\000P\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!h\b\128\b \146\026\000\017\000\230\001\002\000HH\002 \003\b\004\135\000\004@\025\128A\132\018\018\000\136\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000f\001\002\016@\018\000\000\000\000 \000\128\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\001\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\135\000\004@\029\128@\128\016\004\128\000\128\000\b\000(\000\000\b\002\000\001\000\001 \000\000\000\002\000\n\000\000\002\000\128\000@\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \003\b\004\135\000\004@\025\128A\132\018\018\000\136\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000\000\000\000\000\000\000\136\000\000\016\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\012\164\001\t\000L\018+\000\016\025\000\000P@\001\000\000\000\b\003D\b\000\000\016\000\000\000\000!\000\000\000\000\002\130\020\012\000\000\002\001\000\000\b@\000\000\000\000\160\132\003\000\000\000\128@\000\002\016\000\000\000\000 !\000\192\000\000 \016\000\000\b\000\000\000\001\001\000\016\000\000\000\000\000\000 \000\000\000\000\000@@\004\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\144\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\134\003\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000\b\004\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\t\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\001\000\016\000\000\000\000\000\000 \000\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\000\000\002\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193\"\176\001\001\144\000\005\004\0008\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000 \000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193\"\176\001\001\144\000\005\004\0008\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241'\208\004\015\128\000\001\142\0026\016\001`\163|H\244\001\003\224\000\000c\130\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\209\006\000\000\004\000\000\000\b\000\016\000\000\000\1284A\128\000\001\000\000\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000\000\200A\000\200\004\193&\208\001\001\128\000\001\004\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\012\132\016\b\000L\018m\000\016\024\000\000\016@\003!\004\002\000\019\004\139@\004\006\000\000\004\016\000\200@\000\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\002\000\002\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000 \000@\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\016\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193&\176\001\001\128\000\001\004\0002\144\004$\0010H\172\000@`\000\000A\000\012\164\001\t\001L\018+\000\016\024\000\000\016@\001\000\000\000\b\003D\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\016\000\000\000\1284@\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\169*Pb\139L\254\240D\007\152\004\0305!jJ\148\024\162\211?\188\017\001\230\001\007\141@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\168\000\130!!\192\193\016\006`\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\003\004@\025\128A\128P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \n\128\b\"\018\028\012\017\000f\001\006\001@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000! \n\128\b\"\018\028\012\017\000f\001\006\001@2\016@ \0010H\180\000@`\000\000A\000\012\132\000\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000 \000 \000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\028\012\000\000\002\001\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\1284@\128\000\001\000\000\000\000\002\016\000\000\000\000 !\192\192\000\000 \016\000\016\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001q\128\000@\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b@0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\128\016\012\000\003\001 \r\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\002\000\209\002\000\000\004\000\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\128\016\012\164\001\t\000L\018+\000\016\025\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\012\164\001\t\000L\018+\000\016\025\000\000P@\132\128\"\000 \128H`\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\016\000\016\000f\000\002\000\0002\016@0\0010I\180\000@`\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\016\000\017\000f\000\002\000HH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H@\000D\001\152\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\016\000f\000\002\000\bH\002 \002\b\004\132\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\000\001\144\006`\000 \004\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004\000\025\128\000\128\002\018\000\136\000\130\001!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\017\000v\000\"\000L\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\132\003\000\000\000\128@\000\002\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\b\000\004\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\000\000\000\128\000\000 \001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\000 \0010H\180\000@h\000\000E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000H\000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\004\000\004\128\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\0000\128Hp\000D\001\216\000\024@\000H\000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\000\b@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\0000\128Hp\000D\001\216\000\024@\000H\000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\002\000\000 \000\128\000\000 \000\000\004\000\004\128\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\000 \128H`\000D\001\152\000\b@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000 \000\000\000\000\0000\000\b\000\0001q\128\000H\000\b\000\000\000\012\000\002\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\001\000\000\000\016\000\000\000H\000\000\000\000\000\012\000\002\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\001\000\000\000\004\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\128\000\000\000\001\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\135\000\004@\025\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200\0008\016\000\197\194\128\001\000\128 \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\002\000\000 \000\128\000\000 \000\000\004\000\004\128\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\000 \128\b`\000@\001\152\000\b@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002 \130\b\000\134\000\004\000\029\128D\128\016\012\128\003\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000 \000\002\000\b\000\000\002\000\000\000@\000H\000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002 \002\b\000\134\000\004\000\025\128\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\000\b \002\016\000\016\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\001\000\000\000\001\000\018\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\248H\005\138\173\2433\208\021\015\228\000\003\142\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\022\132\128\000\130\r!\001\001\016\014@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\000\b \018\016\000\017\000d\016\002\000\000\016\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\128\000\130\001!\000\001\000\006\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\b\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002~\018\001b\171|\204\244\005C\249\000\000\227\128\159\132\128X\170\2233=\001P\254@\0008\224\004\128 \000 \128H@\000D\001\144\000\b\000\001 \b\000\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128H`\000D\001\144\000\b\000\001 \b\000\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\000\b \018\024\000\017\000d\000\002\000\000H\002\000\002\b\004\132\000\004@\025\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
+ (122, "'\225 \022*\183\204\207@P?\144\000\0148\b\216@\005\194\141\241'\208\004\015\128\000\001\142\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\254\182mf\235\252\205\255\005G\248\132A\231\129\247\217\016\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|I\244\001\003\224\000\000c\129\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\031\128\176\144\000\015\136\128A\000@\162\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\131\023\b\000\004\000\000\000\000\000\000@\016\000@ \193\004\000\000\016\000\000\000\000\000\016\004\000\000\b0A\000\000\004\000\000\000\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\196\128*\000 \194Hp\000D\001\216@\136\001! \b\000\b \002\020\000\016\000b\000\002\000\bH\002\000\002\b\000\132\000\004\000\024\128\000\128\000\012\000\002\012\016L\000@\000\000\000\000\000\000\000\003\000\000\130\004\019\000\016\000\000\000\000\000\000\000\000\192\000 \129\004\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000 \128\004\000\000\000\000\000\000\000\000\000\000 \000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\b \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \002\024\000\016\000v\001\018\000@2\000\014\004\0001p\160\000@ \b\000\004\002\018\000\136\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200\0000\016\000\197\194\128\001\000\128 \000\016\0000\000\140\004\b1p\128\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\000 \201Hp0D\129\216\005\152E\128\192\000 \000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\001\000\000\000\004\128\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\002\020\002F\000\001$!\192\192\018\001!\018\000\016}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\131\004\019\000\016\000\000\000\000\000\000\000\000\192\000 \129\004\192\004\000\000\000\000\000\000\000\0000\000\b A0\000\000\000\000\000\000\000\000\000\012\000\002\b\000L\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\006`\016 \004}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\0026\016\001p\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\132\000@\b\012\0189\000\000\024\000\000\024\192\001\000\000\001\000\001\000\016\000\000\000\000\000\000\000\000@\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000+\250\221\253\155\239\247\255\252\029?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\141\134 ~*\223R=>b\249\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 HB\004\000\128\193#\144\000\001\128\000\001\140\0026\016\001`\163|H\244\001\003\224\000\000s\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000@\002\130\020\012\000\000\002\001\000\000\b@\000\000\000\000\160\133\003\000\000\000\128@\000\002\016\000\000\000\000(!\000\192\000\000 \016\000\000\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\136\031\128\179\148\139O\140\134\193\000d\178\224\000\002\000\000\000\000\000\016\000\001\000\000\000\000\b0\000\000\016\000\000\001\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\n~\018\001b\171|\205\244\005\003\248\128\000\227\130\159\132\128X\170\2233=\001@\254 \0008\224\167\225\"\022*\183\204\207@P?\152\000\0148\000@\128\000@\000\129\004\000\000\016\000\000\000\b\000\016 \000\016\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000\001@\128\000\000\000\129\000\000\000\016\000\000\000\000\0026\016\001`\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001p\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\143@\016>\000\000\00681on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\128\012\132\000\b\000L\018-\000\016\024\000\000\016@\003!\000\002\000\019\004\139@\004\006\128\000\005\016\000\200@\128\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000D\000\000\000\000\000\000\000\001\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\003\000\002\192@\003\023\b\000\004\000\000\000\000P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\001\000\012\000\003\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\001\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\176\002\012\132\135\003\004H\029\128X\132X\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\196\128\187\000 \200Hp0D\129\216\005\136E\128\192\000 \000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\004\000\000\002\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\128\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\000 \201Hp0D\129\216\005\136E\128@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\000 \201Hp0D\129\216\005\136E\128\192\000 \000\000\197\194\000\001\000\000\000\000\000\012X\011\176\002\012\148\135\003\004H\029\128X\132X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \001\000\000\001\000\000\b\000\000\000\004\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\b\000\000\000\004\b\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000 \000\000\000\017 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\b\000\000\000\004H\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\016\000\000\128\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\176\002\012\132\135\003\004H\029\128X\132P\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\012\004\0001p\128\000@\000\000\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\001\000\000\000\004\000\000\000\002\000\000D\000\000\000\000\000\000\000\001\000\000\000\000\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\200@\000\192\004\193&\144\001\001\128\000\001\004\0002\016\000 \0010I\164\000@`\000\000A\000\012\132\000\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\145\180$\0050I\172\000@e\b\027U@\000\004\000\b\000@\000\001\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\164m\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\002\000\138\000\000\000\000\000\000\000 \200B\000\128\004\193\"\208\001\001\160\000\t\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\003\000\019\004\155@\004\006\128\000\004\016\000\200@\000\128\004\193&\208\001\001\160\000\001\004\0002\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\000\006\192\000\016\000\004\000\000\000\020\000LQ\0002\016\000 \0010H\180\000@h\000\000A\002@\000l\000\001\000\000@\000\000\001@\004\197\016\131!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\004\000\001\000\000\000\005\000\019\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027\002\000S\004\155@\004\006\208\0015T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\132l\b\001L\018m\000\016\027@\004\213P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\016\000\000\000\000\001 D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\000\006\192\000\016\000\004\000\000\000\020\000LQ\b2\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000@\000\016\000\000\000P\0011D \000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\004\128\000\000\000\004\000\000\000\000\000HQ\b2\016 \0010H\180\000@h\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\001\000\000\000\000\000\018\004B\000\000D\000\000\000\000\000\000\000\000\000\000\000\000\131\000\001\000\000\001\000\000\000\000\000\000\000\000\000 \000\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193&\176\001\001\144\000M\021\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000@\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\001\000\000\000\004\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0002\016@2\t0I\180\000@h\000\000A\000\004\b\000\004\000\b\016@\000\001\000\000\000\000\128\001\002\000\001\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\192\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000 \001\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\192\000 \128\004\192\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\003\000\000\224@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \020\003\000\000\192@\003\023\b\000\004\000\000\000\000\0001 \n\128\b0\018\028\000\017\000v\001\"\001LH\002\160\002\012\004\135\000\004@\029\128H\128\016\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\012H\002\160\002\012\004\135\000\004@\029\128H\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\168\000\131\t!\192\001\016\007a\002 \004\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\004@\029\132\b\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\000 \192Hp\000D\001\216\000\136\001\000 \000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\196\128*\000 \192Hp\000D\001\216\000\136\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\004\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\196\128*\000 \194Hp\000D\001\216@\136\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\006@\029\128\t\128\016\020\b \000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\0000\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\006@\029\132\t\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\016\000 \000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0026\016!`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\128\000\016\000\000\000\000\000\000\001\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\018\016\001\000 0H\228\000\000`\000\000c\003\000\000D\000\000\000\000\000\0000\001\005\002@\000#a\000\023\n7\196\159@\016>\b\000\0068\b\216@\005\130\141\241'\208\004\015\130\000\001\142\0026\016\001`\163|H\244\001\003\224\128\000c\128\004\132\000D\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\158@\000\006\000\000\0060\000H@\004\000\128\193#\144\000\001\128\000\001\140\000\018\016\001\000 0H\228\000\000`\000\000c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\246\237\127\139\237s\251\255\182\031}\183\255\223\001\000\000\000\000\003\000\142\000\000\000\000\000\000\000(\216b\007\226\173\245#\211\230/\144@\025\174\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\141\132 X(\223\018=\000@\248\000\000\024\224\163a\b\022\n7\196\143@\016>\000\000\0068 @\128\000@\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\002\000\016\000\000\000\000\000\016\000 @\016\000\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000(\216B\005\130\141\241#\208\004\015\128\000\001\142\n6\016\129`\163|H\244\001\003\224\000\000c\130\012\132 \b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\016\000\000\000@\0010D\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224#a\000\023\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241'\208\004\015\128\000\001\142\0026\016\001`\163|H\244\001\003\224\000\000c\128\012\132\000\012\000L\018m\000\016\026\000\000\017@\003!\000\002\000\019\004\155@\004\006\128\000\004P\000\200@\000\128\004\193\"\208\001\001\160\000\001\020\0002\016\000 \0010H\180\000@h\000\000A\000@\000\000\000\001\000\000@\000\000\000\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\202@\016\208\004\193&\176\001\001\128\000\001\004\0002\144\004$\0010I\172\000@`\000\000A\000\012\164\001\t\000L\018+\000\016\024\000\000\016@\002\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\000 \0010H\180\000@h\000\000A\000\000\000 \000\000\000\000@\000\000\001\000\004\193\016\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\004\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\014\134 ~\002\206R->2\027\004\001\146\203\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000@\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@S\004\138\192\004\006\000\000\020\016\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0002\016\0000\0010I\180\000@h\000\000A\000\012\132\000\b\000L\018m\000\016\026\000\000\016@\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0026\016\001`\163|H\244\001\003\224\000\000c\128\004\132\000D\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\158@\000\006\000\000\0060\000H@\004\000\128\193#\144\000\001\128\000\001\140\012IK\176\250\015\133\135\003\254\216\029\246\223\156<\004\132\000@\b\012\0189\000\000\024\000\000\024\192\197\189\187_\226\251\\\254\255\237\135\223m\255\247\192\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\141\132\000X(\223\018=\000@\248\000\000\024\224\197\189\187_\226\251\\\254\255\237\135\223m\255\243\192\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H@\004\000\128\193#\144\000\001\128\000\001\140\012[\219\181\254/\181\207\239\254\216}\246\223\255|\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\130\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\197\189\187_\226\251\\\254\255\237\135\223m\255\243\241%.\195\232>\022\028\015\251`w\219~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\181\207\239\254\216}\246\223\255?\018R\236>\131\225a\192\255\182\007}\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\127[\177\250\175\253\207\247\255[\253\226\223\255\189\247\217\016\130\2545\000\004\193\193\2388\176(4#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\012\132\000\b\000L\018m\000\016\024\000\000\016@\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\202@\016\144\004\193&\176\001\001\144\000m\021\b:\024\129\248\0119H\180\248\200l\016\006K,\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193\"\176\001\001\144\000%\004\0002\016\000 \0010H\164\000@`\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\016\000\000\000@\000\000\000 \192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000d\000\000\000\000@\000\000\001\000\002\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000 \000\006@\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\000L\018+\000\016\025\000\002P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\004\000\000@\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \224\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\b2\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D \200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\128\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0002\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\132\128\"\000 \128H`\000d\001\152\000\b\001! \b\128\b\"\018\024\012\025\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\130\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\130\000\002\004>\000\192@@>\002\001\000\005\130\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\155\015\1280\016\016\015\128\128@\001a\128\232\216B\197\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\00601on\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015\128\000\145\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0000\000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068 \000\000\128\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b\016\248\003\001\001\000\248\b\004\000\022\b\015\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\003\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\130\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156?\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\252[\219\181\254/\181\207\239\254\216}\246\223\255\127\022\246\237\127\139\237s\251\255\150\031x\183\255\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\161\136\031\128\179\148\139O\140\134\193\000d\178\192\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000@\000\000\000\016@\000\000\001\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@S\004\138\192\004\006\000\000\020\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@S\004\138\192\004\006\000\000\020\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\016\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\2402\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000 \141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\b\016\002\003\004\142@\000\006\000\000\0060 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0078\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\133\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\001\000 0H\228\000\000`\000\000c\001\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\004\000\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\000\000 \000\004@\000\000\000\000\000\000\000\000\000\000\000\b\016\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\012\000\001@\000\000\000@\000\000\000\000\192#\128\000\000\000\000\000\000\012\000\001\016\000\000\000\000\000\000\192\004\020\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\237\129\223m\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\145\015\1280\016\016\015\129\128@\001`\128\224\000\004\000\000\000\000\000\000\000@\000\000\000\000\b\000\000\000\000\000\016\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000 \001\000\002\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\bH\002 \002\b$\135\000\006@\025\128\000\128\016\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000@\000\000\000\000@\000\016\000\000\000@\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\bH\002 \002\b$\135\000\006@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\001\000\002\000\024\000\000\002\000\000\000\000\000H\000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000 \000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\002\000\000\000\001\000\000\012\000\002\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000D\000\000\000\000@\000\002\000\000\000\000\016\000\000\017\000\000\000\000\016\000\000\000\000\000\000\000\000\000\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\016\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\016\000\000\128\000\000\000\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\133\128\162\000 \193Hp\000d\001\152\004\bA\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bX\n \002\b\020\135\000\006@\025\128@\132\016\012\000\002\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\000 \000\000\197\194\000\001\000\000\000\000\000\bX\002 \002\b\020\135\000\006@\025\128@\132\018\022\002\136\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\016\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\004\002\000\019\004\155@\004\006\000\000\004\016\000\200A\000\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\000\b\000L\018-\000\016\024\000\000\016@\132\128\"\000 \128H`\000d\001\152\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018R\236>\131\225a\192\255\150\007x\183\231\015@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\020\012IK\176\250\015\133\135\003\254X\029\226\223\156>\000\002 >\000\192@@>\002\001\000\007\194\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\000\000\b0@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\000\000\b0@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000@\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\001\000\000 \000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000! \b\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\000\016\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\001\000\001\000\016\000\000\000\000\000\000\000\000@\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\007`\000 \000\001\000@\000\000\131\004\000\000\000@\000\000\000\0001 \b\128\b0\018\028\000\017\000f\000\002\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\016\000\000\000\000\000\000\000\000\192\001\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\132\128\"\000 \128H`\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@0\000\000\000\000\000\001\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000! \b\128\b \018\024\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\0002\016\000 \0010H\180\000@h\000\000A\000@\000\b\000\000\000\000@\000\000\000\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\159\132\137X\170\2233=\001@\254\000\000x\224\001\002\000\001\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\002\018\000\136\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\132\129\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\001\000\002\000\024\000\000\002\000\000\000\000\000H\000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\002\018\000\136\000\194\001!\192\001\016\007`\000`\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\192\001\016\006a\000!\000\001\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\bH\002 \002\b\004\135\000\004@\025\128\000\128\002\018\000\136\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\128\"\192`\131\031H\000D\001\128\000\b\000! \b\128\b \002\016\000\016\000f\000\002\000\000\016\000\000\016\000\000\001\000\000\000\000\000\000\002\000\004\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b \134\000\004\000\025\132\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b \134\000\004\000\025\132\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\001\000\000\000\016\000\000\000\000\000\000\000\000\192\001\000\000\000\000\004\000\000\000\000\000\000\000\0000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\001@\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b \134\000\004\000\025\132\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\136\000\131\000!\192\001\000\006`\000 \004\132\128\"\000 \128\b@\000@\001\152\000\b\001\000\192\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@\000\000\131\004\000\000\000@\000\000\000\0001 \b\128\b0\002\028\000\016\000f\000\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\002\018\000\136\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\000\004\002\012\016@\000\001\000\000\000\000\000\001\000@\000\000\131\004\016\000\000@\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\001\000\002\000\024\000\000\002\000\000\000\000\000H\000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\002\018\000\136\000\194\000!\192\001\000\006`\000`\000\b\128\000\001\000\001\000\024\000\000\000\000\000\000\000\002\000\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000 \000\b \001\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000 \005\016 \000\000\000\000\000\000\000\132\000\000\000\000\n\bP\016\000\000\b\004\000\000!\000\000\000\000\002\130\016\004\000\000\002\001\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\016\004\000\000\002\001\000\000\000\128\000\000\000\016\016\001\000\000\000\000\000\000\000\000 \000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\002\016\000\000\000\000 !\192@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\128\000\002\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\004\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000H\004\000\000!\000\000\000\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\192\192\000\001 \016\000\000\001\000\000\000\b\001D\024\000\000\000\000\000\000\000\000@\000\000\002\000Q\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000 \000@\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000\000\b\001D\b\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\016\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000@\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000\000\000\000@\000\000\000\000 \000\000\000\001\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \n\128\b\"\018\028\004\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000@\000\000\002\000Q\002\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\001\004@\029\128@\128\018\016\000\000\000\000 !\192@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\198\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000!\000\000\000\000\002\002\028\012\000\000\002\001\000\000\b@\000\000\000\000\128\134\001\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\132\001\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128Hp\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000 \005\016 \000\000\000\000\000\000\000\132\128\"\000 \128Hp\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\024\000\000\000\000\000\000\000\002\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\bX\n\160\002\012\016\135\000\004@\029\128\001\128\016\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\005\000\000\000\b\000\000\000\000@\000\000\000\000\004\001\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\0000\000\b\000\0001p\128\000@\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000\192H\003W\b\000\004\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\002\022\002\168\000\131\004!\192\001\016\007`\000 \004\133\128\170\000 \193\bp\000D\001\216\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\000\135\000\004\000\029\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\000\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000\192H\003W\b\000\004\000\000\000\000\000! \b\128\b \002\024\000\016\000f\000\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\132\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\000\001\000\006`\000 \004\002\000\000\130\000\019\000\016\000\000\000\000\000\000\000\000\128\000 \128\004\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000f\001\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\016\000\016\000f\000\002\000@ \000\b \0010\001\000\000\000\000\000\000\000\000\b\000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\0002\000\014\004\0001p\160\000@ \b\000\004\000\012\000\011\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\160\"\000 \130Hh\000D\003\152\004\b\001! \b\128\012 \018\028\000\017\000f\001\006\016HH\002 \002\b\004\135\000\004@\025\128@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\004\bA\000H\000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128\b`\000@\001\152\004\b\001! \b\128\b \002\016\000\016\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000v\001\002\000@\018\000\002\000\000 \000\160\000\000 \b\000\004\000\004\128\000\000\000\b\000(\000\000\b\002\000\001\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\012 \018\028\000\017\000f\001\006\016HH\002 \002\b\004\135\000\004@\025\128@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\016\000\000\000\000\000\000\000\002 \000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\004$\0010H\172\000@d\000\001A\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\132\000\000\000\000\n\bP0\000\000\b\004\000\000!\000\000\000\000\002\130\016\012\000\000\002\001\000\000\b@\000\000\000\000\128\132\003\000\000\000\128@\000\000 \000\000\000\004\004\000@\000\000\000\000\000\000\128\000\000\000\000\001\001\000\016\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\002\016\000\000\000\000 !\192\192\000\000 \016\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000$\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\128\000\004\000@\000\000\000\000\000\000\128\000\000\000 \000\001\000\016\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\138\192\004\006@\000\020\016\000\224\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\138\192\004\006@\000\020\016\000\224\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b@\000\000\000\000\128\134\003\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\b\003D\024\000\000\016\000\000\000 \000@\000\000\002\000\209\006\000\000\004\000\000\000\000\000\016\000\000\000\1284@\128\000\001\000\000\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\003!\004\003 \019\004\155@\004\006\000\000\004\016\031}\145\b/\227P\000L\028\030\227\139\002\131@2\016@ \0010I\180\000@`\000\000A\000\012\132\016\b\000L\018-\000\016\024\000\000\016@\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\000\000\000\000\000\000\b\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000@\000\000\000\000\000\000\128\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\154\192\004\006\000\000\004\016\000\202@\016\144\004\193\"\176\001\001\128\000\001\004\0002\144\004$\0050H\172\000@`\000\000A\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\000@\000\000\002\000\209\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\022\164\169A\138-3\251\193\016\030`\016x\212\133\169*Pb\139L\254\240D\007\152\004\0305\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\003\004@\025\128A\128P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \n\128\b\"\018\028\012\017\000f\001\006\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\000 \136Hp0D\001\152\004\024\005\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\132\128*\000 \136Hp0D\001\152\004\024\005\000\200A\000\128\004\193\"\208\001\001\128\000\001\004\0002\016\000 \0010H\180\000@`\000\000A\000\000\000\000\000\000\000\000\128\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192H\003W\b\000\004\000\000\000\000\000 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000\b\004\000\004\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\209\002\000\000\004\000\000\000\000\b@\000\000\000\000\128\135\003\000\000\000\128@\000B\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\198\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\002\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\000\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000@0\000\012\004\1285p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000@2\144\004$\0010H\172\000@d\000\001A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\004$\0010H\172\000@d\000\001A\002\018\000\136\000\130\001!\128\001\016\006`\000 \004\132\128\"\000 \128H@\000D\001\152\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H@\000@\001\152\000\b\000\000\200A\000\192\004\193&\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H@\000D\001\152\000\b\001! \b\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000@\001\152\000\b\000! \b\128\b \018\016\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\132\000\006@\025\128\000\128\016\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\016\000f\000\002\000\bH\002 \002\b\004\132\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\000 \194Hp\000D\001\216\000\136\0010\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\0010D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\016\012\000\000\002\001\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016 \000\016\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000\000\000\002\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \200@\000\128\004\193\"\208\001\001\160\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018R\236>\131\225a\192\255\150\007x\183\231\015\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000 \000\002\000\b\000\000\002\000\000\000@\000H\000\000\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\000\002\018\000\136\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\b \128H`\000D\001\216\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000H\000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\004\002\018\000\136\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\002\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\128\000\000\000\000\000\192\000 \000\000\197\198\000\001 \000 \000\000\0000\000\b\000\0001p\128\000H\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\004\000\000\000@\000\000\001 \000\000\000\000\0000\000\b\000\0001p\128\000H\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\016\000\000\004\000\000\000\000\004\000\000\000\016\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\001\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\001\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000\224@\003\023\n\000\004\002\000\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000H\000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\004\002\018\000\136\000\130\000!\128\001\000\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \002\024\000\016\000v\001\018\000@2\000\014\004\0001p\160\000@ \b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128\b`\000@\001\152\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\004\128\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\002\000\b\000\000\002\000\000\000@! \b\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128Hp\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128\b@\000@\001\144\000\b\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\004\000\000\000\004\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \022*\183\204\207@T?\144\000\0148\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000Z\018\000\002\b4\132\004\004@9\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128H@\000D\001\144@\b\000\000@\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\000\002\b\004\132\000\004\000\024\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000 \000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\248H\005\138\173\2433\208\021\015\228\000\003\142\002~\018\001b\171|\204\244\005C\249\000\000\227\128\018\000\128\000\130\001!\000\001\016\006@\000 \000\004\128 \000 \128H@\000D\001\144\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\128\000\130\001!\128\001\016\006@\000 \000\004\128 \000 \128H@\000D\001\144\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128H`\000D\001\144\000\b\000\001 \b\000\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
and start =
7
and action =
- ((16, "C\134O\006B\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\240B\154\000\000\000\000\020\004B\154C\134\028Z\005\162\002\134X\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\001r\000\b\000\000\001|\000\252\000\000\002\208\005\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\244\000\000\000\000\000\000\003\012o\180\000\000\000\000\0032\000\000\000\000\000\000\003\186\003\160\000\000\000\000rTN\200\020\004A\028Y\252\020\004R\154O\006\020\004Lj\000\000\021P\000\000\021P\000\007\000\000\0032\000\000\000\000\000\000\001h\000\000\021P\000\000\003\148^\204\132:b\132\000\000\134`|8\000\000J\136D8\000\000I*\027:M \0032r\174B\154C\134\000\000\000\000O\006\020\004R\188\021P\004&y\018\000\000\129\150B\154C\134O\006\020\004\000\000\000\000\000\000\0164\020\184\000V\005|\000\000\004\182\tF\000\000\000\000\000\000\020\004\000\000@\190\000\000{\210C\134\000\000\000\000NF\020\004BjT\208\000\000\001\022\000\000\000\000\002\n\000\000\000\000F\b\001\022\b\138\000V\005\182\000\017\000\000A\028\006n\006>\019\168\020\180\020\004C\134C\134EjEj\019\168\020\180\020\180\020\004\000\000\000\000\000\000O\006\020\004\000\000\000\244\000\000T\208v>v>\000\000\tL\000\000\000}\n@\000\000\003\168\000\000\000\000 \140o\180b@\000\000rTb@\000\000rTrT\005|\000\000rT\0032\000\000\000\000T:o\180R\172D8\003|\001\016\000\000\001\146\000\000\007R\000\000\0114\000\000\000\000LZ\005|\000\000\000\000D8\007jo\180\000\000MLD8N>\000\000\000\000\000\000\001j\000\000rT\000\000\000\252u\156\000\000o\180\005\192o\180\000\000\023|\b\018\0032\000\000\000\000\024p\000\000\t\144\000\000V\\\005\214\000\000\007rrT\007\190\000\000\t\202\000\000\004F\000\000\000\000\005@\000\000\000\000\000\000\025\000\027\220T\208N\198\020\004T\208\000\000\002\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000KnEH\000\000\000\000\000\000\001\236 \224v>\000\000\000\000wJ\020\004T\208\000\000\000\000P(T\208Q\148|d\000\000p\014\000\000T\208\000\000\000\000U\184\000\000\000\000\b\186\000\000\023<\000\000\000\000|\202\000\000\136\n}D\000\000\136H\003$\000\000\000\000{R\000\000\b\176\000\000\000\000\023\002v\210\000\000\000\000\000\000@\000\019\168\025\248\021\142\000\000\000\000\000\000\000\000\000\028\000\000\000\000W\146\005\012\b\216\002\198o\180\000\216\n\002\000\000\000\000\006\000\b\216\003\180\000\000O\006G\176Ej\019\168\020\180\005\162\004\\\000&\000\000\000\000\000\000\tfA\028A\028\005\162\004\\\007\234A\028\000\000f|\001\224\021P\tL\006Hz\150\000\000o\180c@o\180Z\182c\214o\180\004\174o\180dl\000\000\000\000\021J\001\016[L\tF\001\016\\\006\000\000g\018\001\224\000\000A\028g\168\000\000\005P\011X\\\192\000\000\000\000\000\000\000\000\000\000\0240\000\000\000\000\027\134\000\000\t>\020\180\000\000YfBb\000\000\021\196\000\000\000\000A\028\024\170\000\000\000\000\000\000\000\000X\030\000\000\003\168\000\000I\168\006B\0224\000\000\021\218M\024O\006\020\004H\194N\198\020\004\0164\0164\000\000\000\000\000\000\000\000\001\232\020ZA\168\000\000O\188PrEj\019\168\020\180\006\150A\"\000\000\028\244\000\000Q(Q\222}\170\022do\180\005\162\000\000O\006\020\004\000\000wJ\020\004v>T\208@\160\000\000O\006\020\004y|\000b\000\000T\208@\000o\180\004\168\003\180\nZ\000\000\000\000\000\000F\b\005\b\005\b\000\000\011\180s2\000\000wJ\020\004T\208\023\002\000\000N\198\020\004\0164\021\218\0164\002\220\003\158\000\000\000\000\0164\011\198\000\000\011\216\000\000\0164\003\208\0120\000\000!\212\000\000\007P\000\000\000\000\025\170\000\000\017(\022\206\000\000\000\000\000\000\007\000\000\000\000\000\026\158\000\000\027\146\000\000\028\134\000\000\018\028\023\194\000\000\000\000\000\000B\154\000\000\000\000\000\000\000\000\029z\000\000\030n\000\000\031b\000\000 V\000\000!J\000\000\">\000\000#2\000\000$&\000\000%\026\000\000&\014\000\000'\002\000\000'\246\000\000(\234\000\000)\222\000\000*\210\000\000+\198\000\000,\186\000\000-\174\000\000.\162\000\000/\150\020\004T\208V\230F\240\005\b\012\134h T\208\000\000\000\000\000\000o\180\000\000\026\132\138\004\000\000\024\236o\180\027x\012\018\000\000\000\000\000\000\000\000h \000\000\000\000\002f\012\186\000\000B\146\000\000\000\000\138H\000\000\006\180\000\000\000\000M \005\b\012Vo\180\006\162\000\000\000\000\nP\0032\000\000o\180\tr\000\000\000\000\012\172\000\000\000\000\000\000\025@o\180\n\018\000\000\000\000\027\198\000\000\000\000~$\000\000\028\028~\138\000\000\028\186\127\004\000\000\029\016\004l\000\000\000\000\000\000\000\000\029\174T\208\030\004s\172s\172\000\000\000\000\000\0000\138\000\000\011H\000\000\000\000\000\000h\134\000\000\000\000\000}\bb\000\000h\224\000\000\000\000\000\000ib\000\000\000\000\000\000i\228\000\000\000\000\000\000\0164\004\196\tV\000\000j>\000\000\005\184\000\0001~\000\000j\192\000\000\006\172\000\0002r\000\000kB\000\000\007\160\000\0003f\"\200\000\000\b\014\b\148\000\0004Z\000\000\011\140\t\136\000\0005N\000\000k\196\n|\000\0006B\0046\nJ\000\000l\030\011p\000\00076\000\000l\160\012d\000\0008*\000\000m\"\rX\000\0009\030\014L\000\000:\018\015@\019\016\000\000\000\000\000\000m|\000\000\000\000m\254\000\000\000\000n\128\000\000\t\020\000\000\000\000\000\000\012\172\000\000\r\002\000\000\000\000G\216\005\b\r\210s2D8\002\234\000\000\000\000s2\000\000\000\000\000\000s2\000\000\r\172\000\000\000\000\000\000\000\000\000\000\000\000;\006T\208\000\000\000\000\r\242\000\000;\250\000\000<\238\000\000\030\162\000\000\000\000\006\222\000\000\000\000T\208\000\000\000\000\127\026\t\018\000\000\000\000I\168\000\000\005\212\000\000\000\000]fH\194\000\000St\000\000\012<\000\000\000\000\0022\b\154\000\000\000\000\021\218\025.\tL\000\000\031\152\000\000\031\172\021\184\022\234\000\000\000\000\005\144\000\000\000\000\001\230\021FU0\000\000\024\182\000\000\006\244\000\000\000\000\t`\000\000\000\000]\232\005\188\0022\000\000\000\000\n,\000\000\000\000\012Z\000\000\000\000\000\000\019\168\020\180\004\174\000\000\000\000\007\150\000V\014h\004\\\020\180y\222A\028\020\144\020\180z\\\r\236\000\000\000\000\004\\\000\000E$\020\004\000\142\000\000\b \014l\000\000\014n\000\000\000\000\003\186D8\006\168\000\000\014N\r\228M \n^o\180\0190\005\216\012\132\002\252\000\000\027$\014\156\000\000\006\168\000\000\000\000\014\194D8^\128\000\000d\234D8\014\150D8o\024^\254\005\216\014Z\000\000\000\000\020\004\130\014\000\000T\208s\172\000\000\000\000\014\200\000\000\000\000\000\000=\226\014\240v>>\214_\170\000\000\000\000Cj\000\000\029\028\000\000C\182\000\000\025\182\000\000A\028\029\232\000\000\130p\000\000\019\168\020\180\130p\000\000\025\204\020\184\000V\0032\132\188A\028\127\168s\172\000\000\000V\nF\004\\s\172\000\000\014\230\004\\s\172\134\132\000V\014\242\004\\s\172\134\132\000\000\000\000B\154C\134T\208F4\000\000\000\000B\154C\134Ej\019\168\020\180\130p\000\000\028Z\005\162\002\134\014<o\180\nf\014\250\133\022\000\000s\172\000\000E$\020\004\000\142x\182\007:\t \015\b\128\002\011n\014b\020\004s\172\000\000\020\004s\172\000\000o\180\137v\024\172\007\150\000V\001\016tv\000\000\000V\001\016tv\000\000\025\204\000V\012\250\022z\000\000h \000\000\001T\000\000tv\000\000A\028\133\142h \000\000\b,\000\000\0156\014pA\028\130N\136\134\000V\015:\014vA\028\130N\136\134\000\000\000\000N\200\020\004A\028\130N\000\000E$\020\004\000\142t*\020\184\020\184\019\174\007J\000\000\011\184\021P\tP\000\000\014\244\014\170\024`\020\004Flo\180\011Z\000\000VP\003v\006p\n\156\000\000\n&\000\000\015\004\014\148o\180D|\000\000\020\004\002\216\011B\000\000\011\026\000\000\015\018\014\158M \011\174o\180StD|\000\000X&\019\206\024`\000\000\015B\n:\000V\000\000\011\214\024`o\180\0118\012r\007\164\012\254\000\000\000\000o\180\007\206\003\254\000\000\000\000p(\000\000\000\000\012>\024`p\166D|\000\000\020\004o\180\011Zo\180S\252D|\000\000\011\190\000\000\000\000D|\000\000\000\000VP\000\000s\172\134\222\019\174\007J\011\184\015*\014\216\024`s\172\134\222\000\000\000\000\019\174\007J\011\184\0150\014\196N\018ehD8\015NN\018rT\003\254\015RN\018D8\015ZN\018\011\252\r\028q$q\162\000\000\130\240\000\000\000\000s\172\136\252\019\174\007J\011\184\015P\014\232N\018s\172\136\252\000\000\000\000\000\000\137v\000\000\000\000\000\000\000\000\000\000\000\000h \000\000\135V\020\004\021P\015xy\018\000\000\129\150\135V\000\000\000\000\137\000\020\004\021P\015~\015\016\132:rT\006\168\015\182\000\000\000\000r\026t*\020\004\000\000\128z\000\142\000\000\000\000tv\137\000\000\000\000\000\000\000z\218EZO\200\006\168\015\184\000\000\000\000\000\000t*\020\004\000\000\006\168\015\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r`\020\184\019\174\007J\011\184\015\150t\154B\178\020\004BjG\130\026\158\002\252\006\168\015\162\003\198\000\000\000\000\015T\000\000\000\000F\224\000\000\bX\012\172\000\000\rD\000\000\015\174\015Ro\180Yn\015\218\004<\000\000\000\000\015\136\000\000\000\000\028n\007r\011\186\000\000\015\222u<\131\030\005\b\015~o\180\012\238\000\000\000\000\015\148\000\000\000\000\000\000F\224\000\000\t\132\012\210\000\000\r\150\000\000\015\242\015\128M \000\000\016\000u\222\136J\005\b\015\162o\180\012\244\000\000\000\000\015\182\000\000\000\000\000\000\020\004\000\000F\224\000\000\020&\019\206B\178B\178w\196B\154\020\004\130\014T\208\011&\000\000\011.\000V\000\000\r\144B\178o\180\012\128\005|\000\000\020\004U\184t\154B\178\nBB\178\000\000DfEH\000\000`>\000\000\000\000`\214\000\000\000\000an\000\000\r\172B\178b\006\130\014T\208\011&\000\000\000\"\000\000\000\000N\018\012l\000\000\000\000L\028\016\028\000\000F\224\000\000B\178L\028F\224\000\000\020\004o\180F\224\000\000\r`\000\000\000\000F\224\000\000\000\000G\130\000\000\131JN\018\015\202B\178\131\202t\154\000\000s\172\135\176\019\174\007J\011\184\016 t\154s\172\135\176\000\000\000\000\000\000\137zO\006\000\000\000\000\000\000\000\000\000\000\000\000\133\232s\172\000\000\135V\000\000\000\000\000\000\000\000h \137z\000\000\016V\000\000\000\000\133\232\016b\000\000h \137z\000\000\000\000\r\196\000\000\000\000e\230\026\024\000\000\000\000@\160\000\000o\180\r`\000\000G\130\r\238\000\000\000\000\000\000\r\184\000\000\000\000\000\000Ej\019\168\020\180\004\174\000\000Fz\000\000\030\016\000\000\001\180\000\000\000\000\016l\000\000\016\150{R\000\000?\202\016t\000\000\000\000\016j\0268\022h\000\142x>\007:\020\004\000\000s\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000xP\007:\020\004\000\000\r\242y\018\000\000\129\150\000\000\016z\0268\022hs\172\000\000\016\158\000\000\006\162\r\\\020\004K\150\000\000\000\000\028F\\\234\000\000\000\000\0160\000\000\016\132o\180\000\000\r\138\n\138\005|\000\000\000\000o\180\007\246\b\198\000\000o\180\t\b\006\168\016\170\000\000\000\000\128~\000\000\000\000\132:\000\000tv\000\000\016\162\0268\023\\h \000\000\000\000\000\000\000\000\0144y\018\132:\000\000tv\000\000\016\164\0268\023\\h \000\000\014T\000\000\000\000\030\220\000\000s\172\000\000\016\188\000\000\000\000\016,\000\000\0166\000\000\016J\000\000\000\000K \016f\000\000\000\000o\180\000\000\r\168\000\000\000\000\016h\000\000\000\000T\208\031\150\000\000\000\000H\194\0032\129<\000\000\000\000\000\000\000\000\000\000w<\023l\000\000\000\000\017\b\000\000JV\000\000\014D\017\n\000\000\017\012\000\000I\168I\168\138\\\138\\\000\000\000\000sN\138\\\000\000\000\000\000\000sN\138\\\016~\000\000\016\132\000\000"), (16, "\b\185\b\185\000\006\002\026\005\253\b\185\002\134\002\138\b\185\002\182\002\194\b\185\003V\b\185\006R\002\198\b\185\023n\b\185\b\185\b\185\002\030\b\185\b\185\005\253\006\174\006\178\002\202\b\185\003\n\003\014\t\170\b\185\011\218\b\185\003\206\003\018\023r\002\206\006\182\b\185\b\185\003\150\003\154\b\185\003\158\002\250\003\170\003\178\006\142\004-\b\185\b\185\002~\001j\b\162\003\006\b\185\b\185\b\185\007\214\007\218\007\230\007\250\004-\0056\b\185\b\185\b\185\b\185\b\185\b\185\b\185\b\185\b\185\bn\000\238\b\185\0156\b\185\b\185\002N\bz\b\146\b\230\005B\005F\b\185\b\185\b\185\004-\b\185\b\185\b\185\b\185\b\166\b\194\r\150\b\185\003Z\b\185\b\185\000\238\b\185\b\185\b\185\b\185\b\185\b\185\005J\007\238\b\185\b\185\b\185\b\006\004\018\b\250\015:\b\185\b\185\b\185\b\185\012]\012]\023v\006V\006\005\012]\003}\012]\012]\015F\012]\012]\012]\012]\0046\012]\012]\0061\012]\012]\012]\001\186\012]\012]\006\005\012]\004-\012]\012]\012]\012]\012]\012]\012]\012]\015N\001*\0061\012]\004\162\012]\012]\012]\012]\012]\000\238\012]\012]\017\186\012]\003\174\012]\012]\012]\001v\001\186\012]\012]\012]\012]\012]\012]\012]\000\238\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\003}\012]\012]\0022\012]\012]\004\146\003*\001f\004-\012]\012]\012]\012]\012]\001r\012]\012]\012]\012]\012]\025\022\012]\012]\004>\012]\012]\003.\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\025\026\004-\012]\012]\012]\012]\001\153\001\153\001\153\0042\006\226\001\153\001\162\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\166\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\007\030\b\149\001\153\0026\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\004\150\001\153\001\153\001\153\004B\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\006=\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\n\134\001\153\001\153\n\146\0036\006=\007\222\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\014~\b\030\001\153\005v\001\153\001\153\003:\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\b\149\001\153\001\153\001\153\001\153\001\153\t\237\t\237\018\178\001\002\001\170\t\237\0036\t\237\t\237\003y\t\237\t\237\t\237\t\237\001\186\t\237\t\237\001~\t\237\t\237\t\237\001b\t\237\t\237\018\186\t\237\003:\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\001n\005\254\001z\t\237\004-\t\237\t\237\t\237\t\237\t\237\007\173\t\237\t\237\rf\t\237\001\194\t\237\t\237\t\237\002f\004-\t\237\t\237\t\237\t\237\t\237\t\237\t\237\004-\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\000\238\t\237\t\237\003y\t\237\t\237\004-\001\002\001\170\004Z\t\237\t\237\t\237\t\237\t\237\001\198\t\237\t\237\t\237\t\237\t\018\006j\tB\t\237\001\186\t\237\t\237\003\218\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\004-\t\237\t\237\t\237\t\237\t\237\003\153\003\153\004-\003\222\0042\003\153\006\173\003\153\003\153\001\178\003\153\003\153\003\153\003\153\000\238\003\153\003\153\002B\003\153\003\153\003\153\t\022\003\153\003\153\015V\003\153\007\154\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\r\018\001\210\r\030\003\153\000\238\003\153\003\153\003\153\003\153\003\153\bM\003\153\003\153\003)\003\153\001\186\003\153\003\153\003\153\007\210\004J\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003)\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\006\138\t\n\t:\011\130\003\153\003\153\005\006\000\238\001\214\021\166\003\153\003\153\003\153\003\153\003\153\002\162\003\153\003\153\003\153\003\153\t\018\015\182\tB\003\153\n\134\003\153\003\153\n\146\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\006\170\003\153\003\153\003\153\003\153\003\153\003\141\003\141\001\002\001\170\bM\003\141\003\237\003\141\003\141\024\254\003\141\003\141\003\141\003\141\b\129\003\141\003\141\005\n\003\141\003\141\003\141\021\238\003\141\003\141\012\170\003\141\003\206\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\007\154\n\134\014\254\003\141\n\146\003\141\003\141\003\141\003\141\003\141\000\238\003\141\003\141\000\238\003\141\004\150\003\141\003\141\003\141\005\153\015\006\003\141\003\141\003\141\003\141\003\141\003\141\003\141\014\230\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\237\t\n\t:\007\018\003\141\003\141\b\210\006b\006z\005\018\003\141\003\141\003\141\003\141\003\141\002\226\003\141\003\141\003\141\003\141\t\018\025\002\tB\003\141\002\138\003\141\003\141\014r\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\0042\003\141\003\141\003\141\003\141\003\141\ti\ti\b\145\014v\006\r\ti\003R\ti\ti\005\153\ti\ti\ti\ti\014\n\ti\ti\002\218\ti\ti\ti\014\178\ti\ti\006\r\ti\004-\ti\ti\ti\ti\ti\ti\ti\ti\004-\004-\004\230\ti\004-\ti\ti\ti\ti\ti\007Z\ti\ti\000\238\ti\012.\ti\ti\ti\001\130\004\018\ti\ti\ti\ti\ti\ti\ti\000\238\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\000\238\ti\ti\bj\ti\ti\b\145\006\130\015\254\004-\ti\ti\ti\ti\ti\004-\ti\ti\ti\ti\ti\018\134\ti\ti\003b\ti\ti\003f\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\007\222\004-\ti\ti\ti\ti\ta\ta\004\178\014\014\n\234\ta\b}\ta\ta\018\142\ta\ta\ta\ta\004-\ta\ta\005\129\ta\ta\ta\003q\ta\ta\n\238\ta\014\186\ta\ta\ta\ta\ta\ta\ta\ta\007\154\014\150\015^\ta\006\238\ta\ta\ta\ta\ta\005y\ta\ta\000\238\ta\012F\ta\ta\ta\000\238\006\246\ta\ta\ta\ta\ta\ta\ta\000\238\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\004-\ta\ta\002\138\ta\ta\002\194\tN\018F\011\006\ta\ta\ta\ta\ta\004F\ta\ta\ta\ta\ta\bB\ta\ta\r\218\ta\ta\tR\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\tv\017>\ta\ta\ta\ta\tq\tq\002\209\004-\012\145\tq\014\154\tq\tq\017B\tq\tq\tq\tq\004n\tq\tq\012\145\tq\tq\tq\r\226\tq\tq\004-\tq\000\n\tq\tq\tq\tq\tq\tq\tq\tq\005F\000\238\004\246\tq\nZ\tq\tq\tq\tq\tq\bQ\tq\tq\0042\tq\012^\tq\tq\tq\002\209\tN\tq\tq\tq\tq\tq\tq\tq\be\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\012r\tq\tq\006\210\tq\tq\004\194\000\238\006\170\002Z\tq\tq\tq\tq\tq\004\238\tq\tq\tq\tq\tq\021\198\tq\tq\019\026\tq\tq\000\238\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\006\170\001*\tq\tq\tq\tq\tQ\tQ\002\209\014:\bQ\tQ\004\150\tQ\tQ\021\206\tQ\tQ\tQ\tQ\006\018\tQ\tQ\005y\tQ\tQ\tQ\011\222\tQ\tQ\be\tQ\000\n\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\011\238\006\022\011\254\tQ\005\210\tQ\tQ\tQ\tQ\tQ\026\030\tQ\tQ\015>\tQ\012v\tQ\tQ\tQ\002\209\017\198\tQ\tQ\tQ\tQ\tQ\tQ\tQ\r\246\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\r.\tQ\tQ\bi\tQ\tQ\006f\014>\r\250\000\238\tQ\tQ\tQ\tQ\tQ\002\254\tQ\tQ\tQ\tQ\tQ\002\230\tQ\tQ\002\138\tQ\tQ\014\162\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\018V\000\238\tQ\tQ\tQ\tQ\tY\tY\022R\014\166\007\142\tY\026\"\tY\tY\006\170\tY\tY\tY\tY\002\234\tY\tY\003\198\tY\tY\tY\012\030\tY\tY\022Z\tY\b\129\tY\tY\tY\tY\tY\tY\tY\tY\0126\r2\012N\tY\bi\tY\tY\tY\tY\tY\007\165\tY\tY\000\238\tY\012\138\tY\tY\tY\n\202\004\254\tY\tY\tY\tY\tY\tY\tY\000\238\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\0026\tY\tY\011\"\tY\tY\006v\014\194\018\146\b\129\tY\tY\tY\tY\tY\006\190\tY\tY\tY\tY\tY\004-\tY\tY\002\230\tY\tY\016\146\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\016\158\b\129\tY\tY\tY\tY\t\145\t\145\011\018\b\190\005\133\t\145\000\238\t\145\t\145\011\018\t\145\t\145\t\145\t\145\001\186\t\145\t\145\003\210\t\145\t\145\t\145\012\174\t\145\t\145\004\150\t\145\000\238\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\012\194\011F\012\214\t\145\014\198\t\145\t\145\t\145\t\145\t\145\023\026\t\145\t\145\000\238\t\145\012\158\t\145\t\145\t\145\002f\018\138\t\145\t\145\t\145\t\145\t\145\t\145\t\145\005\137\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\011\026\t\145\t\145\017\022\t\145\t\145\018\250\015r\018\190\026\006\t\145\t\145\t\145\t\145\t\145\nZ\t\145\t\145\t\145\t\145\t\145\004-\t\145\t\145\004F\t\145\t\145\011\190\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\019\018\007^\t\145\t\145\t\145\t\145\t\129\t\129\011\194\018\182\007\177\t\129\002\230\t\129\t\129\018v\t\129\t\129\t\129\t\129\011\190\t\129\t\129\004N\t\129\t\129\t\129\002\174\t\129\t\129\007\181\t\129\000\238\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\001\198\012\134\004E\t\129\019z\t\129\t\129\t\129\t\129\t\129\017N\t\129\t\129\000\238\t\129\012\186\t\129\t\129\t\129\b\222\011\018\t\129\t\129\t\129\t\129\t\129\t\129\t\129\022\014\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\019&\t\129\t\129\019f\t\129\t\129\022\230\004E\002\233\007\165\t\129\t\129\t\129\t\129\t\129\t&\t\129\t\129\t\129\t\129\t\129\018N\t\129\t\129\t.\t\129\t\129\014*\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\0042\014\206\t\129\t\129\t\129\t\129\ty\ty\014.\019\006\023~\ty\018\210\ty\ty\019~\ty\ty\ty\ty\001\186\ty\ty\014\210\ty\ty\ty\t>\ty\ty\023\130\ty\007.\ty\ty\ty\ty\ty\ty\ty\ty\015\130\022\254\nr\ty\003e\ty\ty\ty\ty\ty\020\014\ty\ty\n\170\ty\012\206\ty\ty\ty\018\238\019J\ty\ty\ty\ty\ty\ty\ty\n\206\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\021\202\ty\ty\007.\ty\ty\022V\017\166\012\153\004F\ty\ty\ty\ty\ty\n\254\ty\ty\ty\ty\ty\017\222\ty\ty\004F\ty\ty\012\165\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\021\210\019&\ty\ty\ty\ty\t\137\t\137\019\030\011.\023\190\t\137\000\238\t\137\t\137\000\238\t\137\t\137\t\137\t\137\r>\t\137\t\137\020\018\t\137\t\137\t\137\025\202\t\137\t\137\024\198\t\137\007\129\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\022^\022.\005}\t\137\022\142\t\137\t\137\t\137\t\137\t\137\026\002\t\137\t\137\024\226\t\137\012\226\t\137\t\137\t\137\024\158\rF\t\137\t\137\t\137\t\137\t\137\t\137\t\137\000\238\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\024\210\t\137\t\137\007\169\t\137\t\137\rZ\004\193\r\138\001\186\t\137\t\137\t\137\t\137\t\137\r\182\t\137\t\137\t\137\t\137\t\137\023\194\t\137\t\137\000\238\t\137\t\137\022\242\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\023R\001\186\t\137\t\137\t\137\t\137\t\217\t\217\025\150\007.\026\166\t\217\026\018\t\217\t\217\027\003\t\217\t\217\t\217\t\217\004E\t\217\t\217\007.\t\217\t\217\t\217\014\250\t\217\t\217\024\162\t\217\015\026\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\026z\015B\024\230\t\217\015J\t\217\t\217\t\217\t\217\t\217\024\214\t\217\t\217\015f\t\217\012\238\t\217\t\217\t\217\002\174\015j\t\217\t\217\t\217\t\217\t\217\t\217\t\217\015\146\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\015\166\t\217\t\217\015\190\t\217\t\217\015\210\015\250\016\014\016\162\t\217\t\217\t\217\t\217\t\217\016\182\t\217\t\217\t\217\t\217\t\217\026\170\t\217\t\217\017\014\t\217\t\217\017\026\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\003\190\005\206\t\217\t\217\t\217\t\217\003\137\003\137\017\226\017\230\017\250\003\137\017\254\003\137\003\137\018^\003\137\003\137\003\137\003\137\018b\003\137\003\137\018\154\003\137\003\137\003\137\018\158\003\137\003\137\018\198\003\137\018\202\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\018\246\019\174\019\178\003\137\019\214\003\137\003\137\003\137\003\137\003\137\019\218\003\137\003\137\019\234\003\137\019\250\003\137\003\137\003\137\020\006\020B\003\137\003\137\003\137\003\137\003\137\003\137\003\137\020F\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\020\146\t\n\t:\020\186\003\137\003\137\020\190\020\206\021\030\021>\003\137\003\137\003\137\003\137\003\137\021~\003\137\003\137\003\137\003\137\t\018\021\162\tB\003\137\021\178\003\137\003\137\021\218\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\021\222\003\137\003\137\003\137\003\137\003\137\001\221\001\221\021\234\021\250\022\022\001\221\022&\002\138\001\221\022:\002\194\001\221\t\"\001\221\022f\002\198\001\221\022j\001\221\001\221\001\221\022v\001\221\001\221\022\134\t*\022\154\002\202\001\221\001\221\001\221\001\221\001\221\t2\001\221\023\142\023\230\024\014\002\206\024v\001\221\001\221\001\221\001\221\001\221\024\134\002\250\001\170\025\"\001\221\025*\001\221\001\221\002~\025:\025F\003\006\001\221\001\221\001\221\007\214\007\218\007\230\025\170\012\018\0056\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\025\190\t\n\t:\025\238\001\221\001\221\025\246\0262\026Z\026\146\005B\005F\001\221\001\221\001\221\026\194\001\221\001\221\001\221\001\221\012\026\026\206\012f\001\221\026\214\001\221\001\221\026\223\001\221\001\221\001\221\001\221\001\221\001\221\005J\007\238\001\221\001\221\001\221\b\006\004\018\026\239\027\015\001\221\001\221\001\221\001\221\t\193\t\193\027[\027o\027w\t\193\027\179\002\138\t\193\027\187\002\194\t\193\t\193\t\193\000\000\002\198\t\193\000\000\t\193\t\193\t\193\000\000\t\193\t\193\000\000\t\193\000\000\002\202\t\193\t\193\t\193\t\193\t\193\t\193\t\193\000\000\000\000\000\000\002\206\000\000\t\193\t\193\t\193\t\193\t\193\000\000\002\250\001\170\000\000\t\193\000\000\t\193\t\193\002~\000\000\000\000\003\006\t\193\t\193\t\193\007\214\007\218\007\230\000\000\t\193\0056\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\000\000\t\193\t\193\000\000\t\193\t\193\000\000\000\000\000\000\000\000\005B\005F\t\193\t\193\t\193\000\000\t\193\t\193\t\193\t\193\t\193\000\000\t\193\t\193\000\000\t\193\t\193\000\000\t\193\t\193\t\193\t\193\t\193\t\193\005J\007\238\t\193\t\193\t\193\b\006\004\018\000\000\000\000\t\193\t\193\t\193\t\193\t\189\t\189\000\000\000\000\000\000\t\189\000\000\002\138\t\189\000\000\002\194\t\189\t\189\t\189\000\000\002\198\t\189\000\000\t\189\t\189\t\189\000\000\t\189\t\189\000\000\t\189\000\000\002\202\t\189\t\189\t\189\t\189\t\189\t\189\t\189\000\000\000\000\000\000\002\206\000\000\t\189\t\189\t\189\t\189\t\189\000\000\002\250\001\170\000\000\t\189\000\000\t\189\t\189\002~\000\000\000\000\003\006\t\189\t\189\t\189\007\214\007\218\007\230\000\000\t\189\0056\t\189\t\189\t\189\t\189\t\189\t\189\t\189\t\189\t\189\000\000\t\189\t\189\000\000\t\189\t\189\000\000\000\000\000\000\000\000\005B\005F\t\189\t\189\t\189\000\000\t\189\t\189\t\189\t\189\t\189\000\000\t\189\t\189\000\000\t\189\t\189\000\000\t\189\t\189\t\189\t\189\t\189\t\189\005J\007\238\t\189\t\189\t\189\b\006\004\018\000\000\000\000\t\189\t\189\t\189\t\189\002)\002)\000\000\000\000\000\000\002)\000\000\002\138\002)\000\000\002\194\002)\t\"\002)\000\000\002\198\002)\000\000\002)\002)\002)\000\000\002)\002)\000\000\t*\000\000\002\202\002)\002)\002)\002)\002)\t2\002)\007\153\000\000\000\000\002\206\007\153\002)\002)\002)\002)\002)\000\000\002\250\001\170\000\000\002)\000\000\002)\002)\002~\000\000\000\000\003\006\002)\002)\002)\007\214\007\218\007\230\000\000\012\018\0056\002)\002)\002)\002)\002)\002)\002)\002)\002)\007\153\004\149\002)\000\000\002)\002)\000\000\000\000\004-\000\000\005B\005F\002)\002)\002)\004-\002)\002)\002)\002)\0066\007\153\000\000\002)\004\149\002)\002)\004-\002)\002)\002)\002)\002)\002)\005J\007\238\002)\002)\002)\b\006\004\018\000\000\000\000\002)\002)\002)\002)\004-\000\000\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004\190\004-\000\238\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\000\000\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004-\002\230\004-\004-\004-\004-\004-\004-\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\000\000\004-\006\222\000\000\004-\004-\004-\000\238\004-\000\000\000\000\004-\004-\004-\004-\004-\004-\004-\004-\004-\b\"\001\170\004-\004-\003\142\002\209\002\138\004-\002\209\018:\r\254\004-\004-\003n\014\030\0142\014B\000\000\000\000\004-\004-\004-\007J\000\000\004-\004-\004-\004-\000\000\000\129\004-\000\129\000\n\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\238\000\129\022\186\000\129\000\129\003\138\000\129\000\129\002\209\000\000\000\129\000\129\002~\000\129\000\129\000\000\000\129\000\000\000\129\000\129\002\209\002\209\000\129\000\129\000\000\000\129\000\129\000\129\000\000\000\129\015\014\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\002\230\006\162\000\129\000\129\012I\0125\000\129\000\129\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\000\000\000\000\000\000\000\012I\000\129\000\000\000\129\000\000\000\129\002\006\006}\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\b\"\014\130\002\014\000\129\000\000\002\018\0125\000\000\000\222\006>\r\254\b\169\000\129\006}\014\030\0142\014B\007\166\000\129\000\129\000\129\000\129\000\000\000\000\000\129\000\129\000\129\000\129\002\025\002\025\014b\000\000\000\000\002\025\b\169\002\138\002\025\007\170\002\194\002\025\000\000\002\025\000\000\002\198\002\025\007&\002\025\002\025\002\025\000\000\002\025\002\025\000\000\007.\000\000\002\202\002\025\002\025\002\025\002\025\002\025\0072\002\025\007\154\000\000\000\000\002\206\000\000\002\025\002\025\002\025\002\025\002\025\006\149\002\250\007\234\000\238\002\025\000\000\002\025\002\025\002~\000\000\000\000\003\006\002\025\002\025\002\025\007\214\007\218\007\230\000\000\006\149\0056\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\000\000\t\n\t:\0156\002\025\002\025\002N\000\000\000\000\000\000\005B\005F\002\025\002\025\002\025\000\000\002\025\002\025\002\025\002\025\t\018\007\174\tB\002\025\000\000\002\025\002\025\000\000\002\025\002\025\002\025\002\025\002\025\002\025\005J\007\238\002\025\002\025\002\025\b\006\004\018\000\000\015:\002\025\002\025\002\025\002\025\0025\0025\006\149\000\000\006\170\0025\007=\000\000\0025\015F\000\000\0025\007\226\0025\b\173\000\000\0025\000\000\0025\0025\0025\002\138\0025\0025\000\000\000\000\b\157\000\000\0025\0025\0025\0025\0025\000\000\0025\015N\007=\b\173\000\000\000\000\0025\0025\0025\0025\0025\006\030\000\000\017\170\b\157\0025\007=\0025\0025\007=\bb\005\218\000\000\0025\0025\0025\007=\003\198\025N\017\182\007=\017\198\0025\0025\0025\0025\0025\0025\0025\0025\0025\005\222\t\n\t:\0156\0025\0025\002N\000\000\000\000\000\000\000\238\002\230\0025\0025\0025\000\000\0025\0025\0025\0025\t\018\000\000\tB\0025\000\000\0025\0025\000\000\0025\0025\0025\0025\0025\0025\b9\000\000\0025\0025\0025\000\238\b\246\000\000\015:\0025\0025\0025\0025\0021\0021\000\000\001\002\001\170\0021\000\000\005\226\0021\015F\005\166\0021\000\000\0021\000\000\b\157\0021\005\238\0021\0021\0021\005\250\0021\0021\b9\000\000\000\000\000\000\0021\0021\0021\0021\0021\000\000\0021\015N\005\226\000\000\000\000\005\166\0021\0021\0021\0021\0021\b9\005\238\000\000\000\000\0021\005\250\0021\0021\000\000\000\000\007z\006\222\0021\0021\0021\000\000\000\000\020\234\000\000\000\000\000\000\0021\0021\0021\0021\0021\0021\0021\0021\0021\007~\t\n\t:\b9\0021\0021\000\000\004\190\000\000\000\000\b9\001\186\0021\0021\0021\000\000\0021\0021\0021\0021\t\018\007J\tB\0021\000\000\0021\0021\000\000\0021\0021\0021\0021\0021\0021\b5\000\000\0021\0021\0021\000\238\018f\007\182\006\222\0021\0021\0021\0021\002\029\002\029\002\209\000\000\018\238\002\029\018\242\000\000\002\029\000\000\002~\002\029\000\000\002\029\007\186\000\000\002\029\019\n\002\029\002\029\002\029\000\000\002\029\002\029\b5\000\000\000\n\012\r\002\029\002\029\002\029\002\029\002\029\000\000\002\029\007J\000\000\006\145\000\000\000\000\002\029\002\029\002\029\002\029\002\029\b5\012\r\012\r\000\000\002\029\012\r\002\029\002\029\000\238\002\209\000\000\006\145\002\029\002\029\002\029\006\145\014J\000\000\000\000\000\000\000\000\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\000\000\t\n\t:\b5\002\029\002\029\000\000\004\190\000\000\000\000\b5\000\238\002\029\002\029\002\029\000\000\002\029\002\029\002\029\002\029\t\018\000\238\tB\002\029\000\000\002\029\002\029\000\000\002\029\002\029\002\029\002\029\002\029\002\029\017v\000\000\002\029\002\029\002\029\000\000\000\000\012\r\000\000\002\029\002\029\002\029\002\029\002-\002-\000\000\000\000\006\145\002-\nE\006\222\002-\n\158\000\000\002-\000\000\002-\t\n\t:\002-\000\000\002-\002-\002-\000\000\002-\002-\002\209\016j\016>\000\000\002-\002-\002-\002-\002-\t\018\002-\tB\nE\000\000\002\209\004\153\002-\002-\002-\002-\002-\006:\002\138\007J\000\n\002-\nE\002-\002-\nE\011>\024\174\006\222\002-\002-\002-\nE\000\000\004\153\000\000\nE\000\238\002-\002-\002-\002-\002-\002-\002-\002-\002-\024\178\002\209\002-\007\165\002-\002-\007\165\000\000\000\000\000\000\000\000\003\198\002-\002-\002-\000\000\002-\002-\002-\002-\000\000\007J\022\014\002-\000\000\002-\002-\000\000\tZ\002-\002-\002-\002-\002-\012\021\016B\002-\002-\002-\000\238\000\000\000\000\007\165\002-\002-\002-\002-\b\181\b\181\000\000\000\000\004-\b\181\012\021\012\021\b\181\007\165\012\021\b\181\000\000\b\181\000\000\000\000\t\130\000\000\b\181\t\166\b\181\000\000\b\181\b\181\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\b\181\007\165\000\000\000\000\000\000\004-\b\181\b\181\t\234\t\242\b\181\000\000\000\238\004-\000\000\b\181\000\000\t\250\b\181\000\000\000\000\000\000\000\000\b\181\b\181\000\238\000\000\000\000\007\165\000\000\000\000\000\000\b\181\b\181\t\138\t\202\n\002\n\n\n\026\b\181\b\181\000\000\012\021\b\181\000\000\b\181\n\"\000\000\000\000\000\000\000\000\012)\007\149\b\181\b\181\n*\007\149\b\181\b\181\b\181\b\181\000\000\000\000\012)\b\181\000\000\b\181\b\181\000\000\nJ\b\181\nR\n\018\b\181\b\181\012\017\000\000\b\181\n2\b\181\021\150\000\000\000\000\006\222\b\181\b\181\n:\nB\002a\002a\000\000\012)\007\149\002a\012\017\012\017\002a\000\000\012\017\002a\000\000\002a\007\134\000\000\002a\000\000\002a\002a\002a\000\000\002a\002a\000\000\007\149\000\000\000\000\002a\002a\002a\002a\002a\012)\002a\007J\012)\006\165\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\238\000\000\000\000\002a\000\000\002a\002a\000\238\000\000\000\000\006\165\002a\002a\002a\006\165\000\000\004\190\002r\000\000\000\000\002a\002a\t\138\002a\002a\002a\002a\002a\002a\000\000\012\017\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\000\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\001\186\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\025\222\000\000\002a\002a\002a\004-\011R\000\000\000\000\002a\002a\002a\002a\002I\002I\000\000\000\000\005&\002I\000\238\011Z\002I\000\n\011f\002I\000\000\002I\004-\002f\002I\011r\002I\002I\002I\011~\002I\002I\002\209\002\209\000\000\000\000\002I\002I\002I\002I\002I\000\000\002I\004-\0075\002\209\000\000\000\000\002I\002I\002I\002I\002I\004Z\000\000\000\238\004\197\002I\0075\002I\002I\005\166\000\000\000\000\006\222\002I\002I\002I\0075\000\000\000\000\000\000\0075\000\000\002I\002I\t\138\002I\002I\002I\002I\002I\002I\bN\006\222\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\007M\000\000\002I\002I\002I\000\000\002I\002I\002I\002I\016.\007J\000\000\002I\000\000\002I\002I\022\006\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\002I\002I\000\238\007M\007J\000\000\002I\002I\002I\002I\002U\002U\000\000\000\000\000\000\002U\000\238\007M\002U\000\000\005\166\002U\000\238\002U\000\000\000\000\t\130\007M\002U\002U\002U\007M\002U\002U\000\000\000\000\000\000\000\000\002U\002U\002U\t\194\002U\000\000\002U\000\000\007i\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\005\226\002U\002U\005\166\000\000\000\000\006\222\002U\002U\002U\007i\000\000\000\000\000\000\007i\000\000\002U\002U\t\138\t\202\002U\002U\002U\002U\002U\016J\006\222\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007a\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\025\014\007J\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\238\007a\007J\000\000\002U\002U\002U\002U\002e\002e\000\000\000\000\000\000\002e\000\238\011\150\002e\000\000\007a\002e\000\238\002e\000\000\000\000\002e\007a\002e\002e\002e\007a\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\002e\000\000\0071\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\000\000\000\000\000\002e\0071\002e\002e\005\166\000\000\000\000\006\222\002e\002e\002e\0071\000\000\000\000\000\000\0071\000\000\002e\002e\t\138\002e\002e\002e\002e\002e\002e\026\178\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\000\000\002e\002e\002e\000\000\002e\002e\002e\002e\000\000\007J\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\238\r\206\000\000\000\000\002e\002e\002e\002e\002E\002E\000\000\000\000\000\000\002E\000\000\011Z\002E\000\000\011f\002E\000\000\002E\000\000\000\000\002E\011r\002E\002E\002E\011~\002E\002E\000\000\000\000\000\000\006\181\002E\002E\002E\002E\002E\000\000\002E\000\000\000\000\006\149\000\000\000\000\002E\002E\002E\002E\002E\000\000\006\181\000\000\000\000\002E\006\181\002E\002E\000\000\000\000\000\000\006\149\002E\002E\002E\006\149\000\000\000\000\000\000\000\000\000\000\002E\002E\t\138\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\000\238\000\000\002E\002E\002E\000\000\002E\002E\002E\002E\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\002E\002E\000\000\000\000\006\181\027\031\002E\002E\002E\002E\002Q\002Q\000\000\000\000\007\226\002Q\000\000\005\226\002Q\n\134\005\166\002Q\n\146\002Q\000\000\000\000\t\130\005\238\002Q\002Q\002Q\005\250\002Q\002Q\000\000\000\000\000\000\006\141\002Q\002Q\002Q\t\194\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\006\141\000\000\000\000\002Q\006\141\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\t\138\t\202\002Q\002Q\002Q\002Q\002Q\000\000\002\230\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\005z\006\141\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\003\182\000\000\002M\000\000\006\006\002M\003\194\000\000\002M\003\230\002M\000\000\000\000\t\130\000\000\002M\002M\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\t\194\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\t\138\t\202\002M\002M\002M\002M\002M\000\000\002\138\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\002M\000\000\tF\003\198\000\000\002M\002M\002M\002M\002u\002u\000\000\000\000\000\000\002u\000\000\011\182\002u\011\198\000\000\002u\000\000\002u\000\000\000\000\t\130\000\000\002u\002u\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\t\234\t\242\002u\000\000\000\000\000\000\000\000\002u\000\000\t\250\002u\000\000\000\000\000\000\000\000\002u\002u\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\t\138\t\202\n\002\n\n\n\026\002u\002u\000\000\002\138\002u\000\000\002u\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\n*\000\000\002u\002u\002u\002u\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\n\018\002u\002u\000\000\000\000\002u\n2\002u\000\000\012j\003\198\000\000\002u\002u\n:\nB\002]\002]\000\000\000\000\000\000\002]\000\000\012~\002]\012\146\000\000\002]\000\000\002]\000\000\000\000\t\130\000\000\002]\002]\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\t\194\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\138\t\202\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002Y\002Y\000\000\000\000\000\000\002Y\000\000\000\000\002Y\000\000\000\000\002Y\000\000\002Y\000\000\000\000\t\130\000\000\002Y\002Y\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\t\194\002Y\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\138\t\202\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002m\002m\000\000\000\000\000\000\002m\000\000\000\000\002m\000\000\000\000\002m\000\000\002m\000\000\000\000\t\130\000\000\002m\002m\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\t\234\t\242\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\138\t\202\n\002\n\n\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\n\018\002m\002m\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002A\002A\000\000\000\000\000\000\002A\000\000\000\000\002A\000\000\000\000\002A\000\000\002A\000\000\000\000\t\130\000\000\002A\002A\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\t\194\002A\000\000\002A\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002A\000\000\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\t\138\t\202\002A\002A\002A\002A\002A\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\002A\002A\002A\002A\002A\002A\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002=\002=\000\000\000\000\000\000\002=\000\000\000\000\002=\000\000\000\000\002=\000\000\002=\000\000\000\000\t\130\000\000\002=\002=\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002=\000\000\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\t\234\t\242\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\002=\002=\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\t\138\t\202\n\002\n\n\002=\002=\002=\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\000\000\002=\002=\002=\002=\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\002=\002=\002=\n\018\002=\002=\000\000\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002\153\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\000\000\002\153\000\000\002\153\000\000\000\000\t\130\000\000\002\153\002\153\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002\153\000\000\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\234\t\242\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\138\t\202\n\002\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\002\153\002\153\002\153\n\018\002\153\002\153\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\0029\0029\000\000\000\000\000\000\0029\000\000\000\000\0029\000\000\000\000\0029\000\000\0029\000\000\000\000\t\130\000\000\0029\0029\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\0029\000\000\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\t\234\t\242\0029\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\0029\0029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\t\138\t\202\n\002\n\n\0029\0029\0029\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\0029\0029\0029\n\018\0029\0029\000\000\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\0029\0029\0029\0029\002q\002q\000\000\000\000\000\000\002q\000\000\000\000\002q\000\000\000\000\002q\000\000\002q\000\000\000\000\t\130\000\000\002q\002q\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002q\000\000\002q\000\000\000\000\000\000\000\000\000\000\002q\002q\t\234\t\242\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\t\138\t\202\n\002\n\n\002q\002q\002q\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\002q\002q\002q\002q\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\002q\002q\002q\n\018\002q\002q\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\002q\002i\002i\000\000\000\000\000\000\002i\000\000\000\000\002i\000\000\000\000\002i\000\000\002i\000\000\000\000\t\130\000\000\002i\002i\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\t\234\t\242\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\t\138\t\202\n\002\n\n\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\002i\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\002i\002i\002i\n\018\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002y\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\t\130\000\000\002y\002y\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\t\234\t\242\002y\000\000\000\000\000\000\000\000\002y\000\000\t\250\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\t\138\t\202\n\002\n\n\n\026\002y\002y\000\000\000\000\002y\000\000\002y\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n*\000\000\002y\002y\002y\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\n\018\002y\002y\000\000\000\000\002y\n2\002y\000\000\000\000\000\000\000\000\002y\002y\n:\nB\002}\002}\000\000\000\000\000\000\002}\000\000\000\000\002}\000\000\000\000\002}\000\000\002}\000\000\000\000\t\130\000\000\002}\002}\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\t\234\t\242\002}\000\000\000\000\000\000\000\000\002}\000\000\t\250\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\t\138\t\202\n\002\n\n\n\026\002}\002}\000\000\000\000\002}\000\000\002}\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\n*\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n\018\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\n:\nB\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\130\000\000\002\129\002\129\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\234\t\242\002\129\000\000\000\000\000\000\000\000\002\129\000\000\t\250\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\138\t\202\n\002\n\n\n\026\002\129\002\129\000\000\000\000\002\129\000\000\002\129\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n*\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\n\018\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\n:\nB\bq\bq\000\000\000\000\000\000\bq\000\000\000\000\bq\000\000\000\000\bq\000\000\bq\000\000\000\000\t\130\000\000\bq\bq\bq\000\000\bq\bq\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\bq\000\000\000\000\000\000\000\000\000\000\bq\bq\t\234\t\242\bq\000\000\000\000\000\000\000\000\bq\000\000\t\250\bq\000\000\000\000\000\000\000\000\bq\bq\000\238\000\000\000\000\000\000\000\000\000\000\000\000\bq\bq\t\138\t\202\n\002\n\n\n\026\bq\bq\000\000\000\000\bq\000\000\bq\n\"\000\000\000\000\000\000\000\000\000\000\000\000\bq\bq\n*\000\000\bq\bq\bq\bq\000\000\000\000\000\000\bq\000\000\bq\bq\000\000\bq\bq\bq\n\018\bq\bq\000\000\000\000\bq\n2\bq\000\000\000\000\000\000\000\000\bq\bq\n:\nB\002\133\002\133\000\000\000\000\000\000\002\133\000\000\000\000\002\133\000\000\000\000\002\133\000\000\002\133\000\000\000\000\t\130\000\000\002\133\002\133\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\234\t\242\002\133\000\000\000\000\000\000\000\000\002\133\000\000\t\250\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\138\t\202\n\002\n\n\n\026\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n*\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\nJ\002\133\nR\n\018\002\133\002\133\000\000\000\000\002\133\n2\002\133\000\000\000\000\000\000\000\000\002\133\002\133\n:\nB\bm\bm\000\000\000\000\000\000\bm\000\000\000\000\bm\000\000\000\000\bm\000\000\bm\000\000\000\000\t\130\000\000\bm\bm\bm\000\000\bm\bm\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\bm\000\000\000\000\000\000\000\000\000\000\bm\bm\t\234\t\242\bm\000\000\000\000\000\000\000\000\bm\000\000\t\250\bm\000\000\000\000\000\000\000\000\bm\bm\000\238\000\000\000\000\000\000\000\000\000\000\000\000\bm\bm\t\138\t\202\n\002\n\n\n\026\bm\bm\000\000\000\000\bm\000\000\bm\n\"\000\000\000\000\000\000\000\000\000\000\000\000\bm\bm\n*\000\000\bm\bm\bm\bm\000\000\000\000\000\000\bm\000\000\bm\bm\000\000\bm\bm\bm\n\018\bm\bm\000\000\000\000\bm\n2\bm\000\000\000\000\000\000\000\000\bm\bm\n:\nB\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\130\000\000\002\181\002\181\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\234\t\242\002\181\000\000\000\000\000\000\000\000\002\181\000\000\t\250\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\138\t\202\n\002\n\n\n\026\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n*\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\nJ\002\181\nR\n\018\002\181\002\181\000\000\000\000\002\181\n2\002\181\000\000\000\000\000\000\000\000\002\181\002\181\n:\nB\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\130\000\000\002\177\002\177\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\234\t\242\002\177\000\000\000\000\000\000\000\000\002\177\000\000\t\250\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\138\t\202\n\002\n\n\n\026\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n*\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\nJ\002\177\nR\n\018\002\177\002\177\000\000\000\000\002\177\n2\002\177\000\000\000\000\000\000\000\000\002\177\002\177\n:\nB\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\130\000\000\002\185\002\185\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\234\t\242\002\185\000\000\000\000\000\000\000\000\002\185\000\000\t\250\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\138\t\202\n\002\n\n\n\026\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n*\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\nJ\002\185\nR\n\018\002\185\002\185\000\000\000\000\002\185\n2\002\185\000\000\000\000\000\000\000\000\002\185\002\185\n:\nB\002\165\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\t\130\000\000\002\165\002\165\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\234\t\242\002\165\000\000\000\000\000\000\000\000\002\165\000\000\t\250\002\165\000\000\000\000\000\000\000\000\002\165\002\165\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\138\t\202\n\002\n\n\n\026\002\165\002\165\000\000\000\000\002\165\000\000\002\165\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\n*\000\000\002\165\002\165\002\165\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\nJ\002\165\nR\n\018\002\165\002\165\000\000\000\000\002\165\n2\002\165\000\000\000\000\000\000\000\000\002\165\002\165\n:\nB\002\169\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\130\000\000\002\169\002\169\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\234\t\242\002\169\000\000\000\000\000\000\000\000\002\169\000\000\t\250\002\169\000\000\000\000\000\000\000\000\002\169\002\169\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\138\t\202\n\002\n\n\n\026\002\169\002\169\000\000\000\000\002\169\000\000\002\169\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n*\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\nJ\002\169\nR\n\018\002\169\002\169\000\000\000\000\002\169\n2\002\169\000\000\000\000\000\000\000\000\002\169\002\169\n:\nB\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\130\000\000\002\173\002\173\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\234\t\242\002\173\000\000\000\000\000\000\000\000\002\173\000\000\t\250\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\138\t\202\n\002\n\n\n\026\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n*\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\nJ\002\173\nR\n\018\002\173\002\173\000\000\000\000\002\173\n2\002\173\000\000\000\000\000\000\000\000\002\173\002\173\n:\nB\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\130\000\000\002\193\002\193\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\234\t\242\002\193\000\000\000\000\000\000\000\000\002\193\000\000\t\250\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\138\t\202\n\002\n\n\n\026\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n*\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\nJ\002\193\nR\n\018\002\193\002\193\000\000\000\000\002\193\n2\002\193\000\000\000\000\000\000\000\000\002\193\002\193\n:\nB\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\130\000\000\002\189\002\189\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\234\t\242\002\189\000\000\000\000\000\000\000\000\002\189\000\000\t\250\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\138\t\202\n\002\n\n\n\026\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n*\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\nJ\002\189\nR\n\018\002\189\002\189\000\000\000\000\002\189\n2\002\189\000\000\000\000\000\000\000\000\002\189\002\189\n:\nB\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\130\000\000\002\197\002\197\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\234\t\242\002\197\000\000\000\000\000\000\000\000\002\197\000\000\t\250\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\138\t\202\n\002\n\n\n\026\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n*\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\nJ\002\197\nR\n\018\002\197\002\197\000\000\000\000\002\197\n2\002\197\000\000\000\000\000\000\000\000\002\197\002\197\n:\nB\002\161\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\t\130\000\000\002\161\002\161\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\234\t\242\002\161\000\000\000\000\000\000\000\000\002\161\000\000\t\250\002\161\000\000\000\000\000\000\000\000\002\161\002\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\138\t\202\n\002\n\n\n\026\002\161\002\161\000\000\000\000\002\161\000\000\002\161\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\n*\000\000\002\161\002\161\002\161\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\nJ\002\161\nR\n\018\002\161\002\161\000\000\000\000\002\161\n2\002\161\000\000\000\000\000\000\000\000\002\161\002\161\n:\nB\001\241\001\241\000\000\000\000\000\000\001\241\000\000\000\000\001\241\000\000\000\000\001\241\000\000\001\241\000\000\000\000\001\241\000\000\001\241\001\241\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\001\241\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\001\241\001\241\001\241\001\241\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\001\241\r\166\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\t\130\000\000\002\r\002\r\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\234\t\242\002\r\000\000\000\000\000\000\000\000\002\r\000\000\t\250\002\r\000\000\000\000\000\000\000\000\002\r\002\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\138\t\202\n\002\n\n\n\026\002\r\002\r\000\000\000\000\002\r\000\000\002\r\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\n*\000\000\002\r\002\r\r\190\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\nJ\002\r\nR\n\018\002\r\002\r\000\000\000\000\002\r\n2\002\r\000\000\000\000\000\000\000\000\002\r\002\r\n:\nB\002\t\002\t\000\000\000\000\000\000\002\t\000\000\000\000\002\t\000\000\000\000\002\t\000\000\002\t\000\000\000\000\t\130\000\000\002\t\002\t\002\t\000\000\002\t\002\t\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\t\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\234\t\242\002\t\000\000\000\000\000\000\000\000\002\t\000\000\t\250\002\t\000\000\000\000\000\000\000\000\002\t\002\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\138\t\202\n\002\n\n\n\026\002\t\002\t\000\000\000\000\002\t\000\000\002\t\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\n*\000\000\002\t\002\t\002\t\002\t\000\000\000\000\000\000\002\t\000\000\002\t\002\t\000\000\nJ\002\t\nR\n\018\002\t\002\t\000\000\000\000\002\t\n2\002\t\000\000\000\000\000\000\000\000\002\t\002\t\n:\nB\002\157\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\000\000\000\000\002\157\000\000\002\157\000\000\000\000\t\130\000\000\002\157\002\157\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\157\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\234\t\242\002\157\000\000\000\000\000\000\000\000\002\157\000\000\t\250\002\157\000\000\000\000\000\000\000\000\002\157\002\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\138\t\202\n\002\n\n\n\026\002\157\002\157\000\000\000\000\002\157\000\000\002\157\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\n*\000\000\002\157\002\157\002\157\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\nJ\002\157\nR\n\018\002\157\002\157\000\000\000\000\002\157\n2\002\157\000\000\000\000\000\000\000\000\002\157\002\157\n:\nB\001\253\001\253\000\000\000\000\000\000\001\253\000\000\000\000\001\253\000\000\000\000\001\253\000\000\001\253\000\000\000\000\001\253\000\000\001\253\001\253\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\001\253\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\001\253\001\253\001\253\001\253\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\001\253\r\166\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\000\000\000\000\000\000\006\169\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\006\169\003\233\000\000\002\001\006\169\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\238\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\b\142\002\001\002\001\r\166\000\000\000\000\003\233\000\000\002\001\002\001\002\001\002\001\001\006\000\000\000\006\000\000\000\000\024\186\002\134\002\138\005\226\002\182\002\194\005\166\b\174\000\000\000\000\002\198\001\n\000\000\005\238\000\000\002\254\000\000\005\250\000\000\000\000\000\000\r\146\003\002\001\018\b*\b.\001\030\001\"\000\000\000\000\000\000\003\018\000\000\002\206\000\000\024\238\000\000\bR\bV\000\238\003\158\002\250\003\170\bZ\006\142\bF\001:\000\000\002~\001\238\000\000\003\006\001\238\000\000\000\000\007\214\007\218\007\230\007\250\001\242\0056\000\000\001\242\001>\001B\001F\001J\001N\000\000\000\000\bn\001R\000\000\000\000\000\000\001V\000\000\bz\b\146\b\230\005B\005F\003^\005\226\001Z\003^\005\166\024\190\006\194\001\198\001^\006\194\001\198\005\238\000\000\002~\000\000\005\250\002~\000\000\001\134\n\202\000\000\000\000\005J\007\238\000\000\001\138\000\000\r\238\004\018\b\250\001\006\001\146\000\006\001\150\001\154\000\000\002\134\002\138\000\000\002\182\002\194\006\198\000\000\000\000\006\198\002\198\001\n\000\000\000\000\000\000\b&\000\000\000\000\000\000\000\000\000\000\000\000\003\002\001\018\b*\b.\001\030\001\"\000\000\000\000\000\000\003\018\000\000\002\206\000\000\b2\000\000\bR\bV\000\000\003\158\002\250\003\170\bZ\006\142\000\000\001:\000\000\002~\000\000\000\000\003\006\000\000\000\000\000\000\007\214\007\218\007\230\007\250\000\000\0056\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\bn\001R\000\000\000\000\000\000\001V\000\000\bz\b\146\b\230\005B\005F\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\241\003\142\000\000\002\138\000\000\000\241\000\000\000\000\001\134\005\206\003n\000\000\005J\007\238\000\000\001\138\007\158\r\238\004\018\b\250\n\214\001\146\000\000\001\150\001\154\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\n\218\000>\003\138\002\138\000\241\000B\003\030\000\000\000\000\002~\000F\000\000\000\241\000\000\000\000\000\000\000J\000\241\000N\000R\000V\000Z\000^\000b\000f\000\000\000\241\000\241\000j\000n\000\000\000r\021\134\000v\000\000\000\000\000\000\006\162\000\000\000\238\000\000\000\000\022\194\002\218\000\000\022\198\000\000\000z\000\000\002~\000~\000\130\000\241\000\000\000\000\000\000\022\246\000\134\000\138\000\142\000\000\000\241\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\023\006\000\000\000\000\000\186\005\226\000\190\000\194\005\166\n\222\016&\000\000\000\000\000\000\000\198\005\238\000\202\001\238\000\000\005\250\000\000\000\000\000\206\000\210\004Y\000\214\000\006\001\242\000\000\000\246\002\134\002\138\002\142\002\182\002\194\000\000\000\000\000\000\000\000\002\198\000\000\000\000\003v\000\000\000\000\000\000\004Y\000\000\0166\016\210\003^\002\202\000\000\003\n\003\014\001\238\006\194\001\198\003z\000\000\003\018\000\000\002\206\002~\016f\001\242\003\150\003\154\000\000\003\158\002\250\003\170\003\178\006\142\000\000\000\000\016\202\002~\000\000\000\000\003\006\016\226\000\000\000\000\007\214\007\218\007\230\007\250\003^\0056\000\000\006\198\000\000\000\000\006\194\001\198\000\000\016\234\000\000\bn\000\000\002~\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\016\254\017*\000\000\000\000\004Y\004Y\000\000\000\000\001\182\001\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\198\000\000\017j\021j\005J\007\238\024\218\000\141\001\190\b\006\004\018\b\250\000\141\000\000\002\138\000\141\000\000\002\194\004E\t\"\000\000\000\000\002\198\004E\000\000\000\141\000\000\000\141\000\000\000\141\001\222\002f\t*\000\000\002\202\002j\000\000\002~\003\234\003\246\t2\000\141\000\000\000\000\004\002\002\206\015Z\000\141\000\000\000\000\000\000\000\141\000\000\002\250\001\170\000\000\000\141\000\000\000\000\000\141\002~\004\006\004E\003\006\000\141\000\141\000\141\007\214\007\218\007\230\004E\012\018\0056\000\141\000\141\004E\002\174\000\238\000\000\000\000\000\141\000\000\000\000\000\000\000\141\004E\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\141\000\141\000\000\000\000\000\141\000\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\002\209\004E\000\000\002\209\000\000\000\141\000\141\005J\007\238\000\000\004E\000\165\b\006\004\018\000\000\000\141\000\165\000\141\002\138\000\165\000\000\002\194\000\000\t\"\000\n\000\000\002\198\0156\001*\000\165\002N\000\165\000\000\000\165\000\000\002\209\t*\000\000\002\202\002\209\000\000\003&\002\209\000\000\t2\000\165\021\018\000\000\000\000\002\206\000\000\000\165\002\209\002\209\0032\000\165\000\000\002\250\001\170\000\n\000\165\000\000\000\000\000\165\002~\000\000\015:\003\006\000\165\000\165\000\165\007\214\007\218\007\230\002\209\012\018\0056\000\165\000\165\002\209\015F\002\209\0216\000\000\000\165\000\000\000\000\002\209\000\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\165\000\165\000\000\000\000\000\165\000\165\000\000\000\000\015N\001\006\000\000\002\209\000\000\000\000\000\165\003\"\002\138\b\206\021B\002\194\000\165\000\165\005J\007\238\002\198\001\n\000\000\b\006\004\018\002\254\000\165\000\000\000\165\000\000\016\218\020\214\001\014\001\018\001\022\003B\001\030\001\"\000\000\000\000\003~\000\000\000\000\000\000\000\000\003F\000\000\001.\n\198\007\133\000\000\003>\001\170\0016\000\000\000\249\001:\000\000\002~\000\000\000\249\003\182\025\006\000\000\000\000\003\186\000\000\003\194\005*\001\238\0056\000\000\000\000\001>\001B\001F\001J\001N\000\000\001\242\000\000\001R\005:\000\000\000\000\001V\000\238\000\000\000\000\000\000\005B\005F\000\000\005\134\001Z\000\000\000\000\000\000\000\000\000\249\001^\018n\003^\000\000\000\000\000\000\000\000\000\249\006\194\001\198\001\134\n\202\000\249\004E\005J\002~\000\000\001\138\004E\001\142\004\018\001\006\000\249\001\146\000\000\001\150\001\154\003\"\002\138\nj\005\226\002\194\000\000\005\166\000\000\000\000\002\198\001\n\000\000\000\000\005\238\002\254\000\000\006\198\005\250\000\000\000\000\000\249\001\014\001\018\001\022\003B\001\030\001\"\000\000\000\000\000\249\004E\000\000\000\000\000\000\003F\000\000\001.\n\198\004E\000\000\003>\001\170\0016\004E\002\174\001:\000\000\002~\000\000\000\000\003\182\000\000\004E\004E\003\186\000\000\003\194\005*\000\000\0056\000\000\000\000\001>\001B\001F\001J\001N\004q\000\000\000\000\001R\005:\021\146\000\000\001V\000\000\000\000\000\000\004E\005B\005F\000\000\005\134\001Z\000\000\000\000\000\000\004E\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\001\134\n\202\000\000\000\000\005J\002\209\000\000\001\138\000\000\001\142\004\018\001\006\022\002\001\146\000\000\001\150\001\154\003\"\002\138\rR\016\202\002\194\000\n\000\000\000\000\016\226\002\198\001\n\000\000\000\000\000\000\002\254\000\000\000\000\022\166\022\182\000\000\002\209\001\014\001\018\001\022\003B\001\030\001\"\002\209\000\000\000\000\000\000\000\000\000\000\002\209\003F\000\000\001.\n\198\000\000\000\000\003>\001\170\0016\004q\000\000\001:\000\000\002~\000\000\000\000\003\182\000\000\023\170\000\000\003\186\002\209\003\194\005*\000\000\0056\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005:\000\000\000\000\001V\000\000\000\000\000\000\000\000\005B\005F\000\000\005\134\001Z\000\000\000\000\000\000\000\000\006\150\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\134\n\202\000\000\000\000\005J\000\000\000\000\001\138\000\000\001\142\004\018\000\000\b\137\001\146\000\006\001\150\001\154\000\246\002\134\002\138\002\142\002\182\002\194\000\000\000\000\000\000\000\000\002\198\000\000\000\000\004y\000\000\000\000\000\000\b\137\000\000\000\000\000\000\000\000\002\202\000\000\003\n\003\014\000\000\000\000\000\000\003z\000\000\003\018\000\000\002\206\000\000\016f\000\000\003\150\003\154\000\000\003\158\002\250\003\170\003\178\006\142\000\000\000\000\016\202\002~\000\000\000\000\003\006\016\226\001\182\001\186\007\214\007\218\007\230\007\250\000\000\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\234\000\000\bn\001\190\027*\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\016\254\017*\000\000\000\000\027O\014\142\000\000\000\000\000\000\000\000\000\000\001\222\002n\000\000\000\000\000\000\002j\000\000\002~\003\234\003\246\021j\005J\007\238\b\137\004\002\000\000\b\006\004\018\b\250\000\006\000\000\000\000\000\246\002\134\002\138\002\142\002\182\002\194\000\000\000\000\000\000\004\006\002\198\000\000\025\230\027~\000\000\000\000\000\000\003\190\000\000\000\000\000\000\000\000\002\202\000\000\003\n\003\014\000\000\000\000\025\210\003z\000\000\003\018\000\000\002\206\000\000\016f\000\000\003\150\003\154\000\000\003\158\002\250\003\170\003\178\006\142\000\000\000\000\016\202\002~\000\000\000\000\003\006\016\226\000\000\000\000\007\214\007\218\007\230\007\250\000\000\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\234\000\000\bn\000\000\027*\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\016\254\017*\000\000\000\000\004\129\000\246\000\000\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004y\000\000\000\000\021j\005J\007\238\014\002\012)\012)\b\006\004\018\b\250\012)\000\000\012)\012)\003z\000\000\000\000\000\000\000\000\000\000\016f\012)\000\000\012)\012)\012)\000\000\012)\012)\024*\000\000\000\000\016\202\000\000\000\000\000\000\000\000\016\226\000\000\012)\000\000\000\000\000\000\000\000\000\000\012)\012)\000\000\000\000\012)\000\000\000\000\012)\016\234\012)\000\000\000\000\012)\000\000\000\000\000\000\000\000\012)\012)\012)\000\000\000\000\016\254\017*\000\000\000\000\012)\012)\000\000\000\000\000\000\000\000\000\000\012)\000\000\000\000\000\000\012)\000\000\000\000\012)\000\246\000\000\021j\001\250\000\000\000\000\012)\012)\012)\000\000\012)\012)\000\000\017n\000\000\000\000\000\000\000\000\000\000\000\000\012)\000\000\012)\012)\000\000\000\000\002b\012)\000\000\017r\000\000\000\000\012)\000\000\n]\017\154\012)\n]\012)\012)\n]\n]\000\000\000\000\n]\000\000\n]\016\202\000\000\n]\000\000\000\000\016\226\n]\n]\000\000\n]\n]\000\000\n]\001\182\001\186\000\000\000\000\n]\000\000\000\000\n]\018\018\000\000\000\000\000\000\000\000\000\000\000\000\n]\000\000\n]\001\190\000\000\n]\n]\016\254\018&\000\000\000\000\004M\n]\000\000\000\000\n]\000\000\000\000\n]\n]\000\000\n]\000\000\n]\n]\001\222\002n\000\000\0186\000\000\002j\000\000\002~\003\234\003\246\000\000\n]\000\000\000\000\004\002\000\000\000\000\000\000\000\000\n]\n]\006\133\000\000\n]\000\000\n]\006\133\000\000\000\000\000\000\005b\004\006\000\000\000\000\004\185\000\000\000\000\n]\n]\000\000\n]\n]\000\000\n]\000\000\n]\000\000\n]\000\000\n]\025\210\n]\bu\bu\000\000\000\000\000\000\bu\000\000\001\186\bu\000\000\000\000\000\000\000\000\006\133\012I\0125\bu\000\000\bu\bu\bu\006\133\bu\bu\000\000\000\000\006\133\006\133\000\238\000\000\000\000\000\000\012I\000\000\bu\006\133\006\133\000\000\002\006\000\000\bu\bu\000\000\000\000\bu\002\n\000\000\002f\000\000\bu\000\000\002\014\bu\000\000\002\018\0125\000\000\bu\bu\bu\000\000\006\133\000\000\000\000\000\000\000\000\bu\bu\000\000\000\000\006\133\000\000\000\000\bu\000\000\000\000\000\000\004Z\000\000\000\000\bu\000\000\000\000\000\000\000\000\000\000\023\138\bu\bu\bu\000\000\bu\bu\000\000\000\000\003\129\012]\000\000\000\000\n\150\000\000\bu\000\000\bu\bu\001\182\001\186\n\246\bu\000\000\000\000\000\000\000\000\bu\003\129\000\000\000\000\bu\003\129\bu\bu\012\005\012\005\002v\001\206\000\000\012\005\000\000\001\186\012\005\000\000\000\000\001\218\000\000\000\000\000\000\000\000\004z\000\000\012\005\012\005\012\005\000\000\012\005\012\005\001\222\002^\000\000\000\000\000\000\002j\000\000\002~\003\234\003\246\012\005\000\000\000\000\000\000\004\002\000\000\012\005\012\005\000\000\000\000\012\005\000\000\000\000\002f\000\000\012\005\012]\012]\012\005\000\000\000\000\004\006\000\000\012\005\012\005\012\005\000\000\000\000\000\000\003\129\000\000\000\000\012\005\012\005\000\000\012]\000\000\012]\000\000\012\005\000\000\000\000\000\000\004Z\003\129\000\000\012\005\003\129\000\000\000\000\000\000\000\000\000\000\012\005\012\005\012\005\000\000\012\005\012\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\005\000\000\012\005\012\005\001\182\001\186\000\000\012\005\000\000\000\000\000\000\000\000\012\005\000\000\000\000\000\000\012\005\000\000\012\005\012\005\by\by\001\190\001\206\002\209\by\000\000\001\186\by\002\209\000\000\001\218\000\000\000\000\018f\000\000\by\000\000\by\by\by\000\000\by\by\001\222\019\222\000\000\018\242\000\000\002j\000\000\002~\003\234\003\246\by\000\n\000\000\000\000\019\238\000\000\by\by\000\000\000\000\by\000\000\000\000\002f\002\209\by\002\209\000\000\by\000\000\000\000\004\006\002\209\by\by\by\000\000\002\209\000\000\002\209\000\000\000\000\by\by\000\000\000\000\002\209\002\209\000\000\by\002\209\002\209\002\209\004Z\002\209\000\000\by\000\000\000\000\002\209\000\000\000\000\002\209\by\by\by\000\000\by\by\000\000\000\000\002\209\002\209\000\000\002\209\000\n\000\n\by\002\209\by\by\002\209\002\209\002\209\by\002\209\002\209\002\209\002\209\by\002\209\002\209\002\209\by\000\000\by\by\002\209\002\209\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\000\n\000\000\002\209\006\146\000\000\002\209\002\209\002\209\000\000\014\238\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\000\000\002\209\000\000\000\000\002\209\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\015*\000\000\000\000\0065\002\209\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000\000\000\000\0156\000\000\000!\002N\000\000\002\209\002\209\0065\000\000\000\000\002\209\002\209\002\209\000\000\000!\000\000\000!\000!\000\000\000\000\000\000\000\000\000\000\000!\000\000\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000!\000!\000!\000\000\000\000\015:\000!\007\017\000\000\000!\007\017\000\000\000\000\000!\000!\000!\000!\000\000\000!\015F\000\000\021\022\000\000\000\000\000\000\000\000\007\017\007\017\000!\007\017\007\017\000\000\000\000\000\000\000\000\000!\000!\000!\000!\000!\000\000\000\000\000\000\000\000\0061\015N\000\029\000\000\007\017\000\000\000\029\000\029\000\000\000\029\000\029\021\"\000\000\000\000\000\000\000\029\000\000\000\000\000!\000!\0061\000\000\007\017\000!\000!\000!\000\000\000\029\020\214\000\029\000\029\000\000\000\000\000\000\000\000\000\000\000\029\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\007\017\000\029\007\017\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\000\000\029\005\158\000\000\000\000\007\017\007\017\000\000\000\000\000\000\007\017\000\029\007\017\000\000\000\000\000\000\007\017\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\000\006A\000\000\011\205\000\000\000\000\000\000\011\205\011\205\000\000\011\205\011\205\000\000\000\000\000\000\000\000\011\205\000\000\000\000\000\029\000\029\006A\000\000\000\000\000\029\000\029\000\029\000\000\011\205\000\000\011\205\011\205\000\000\000\000\000\000\000\000\000\000\011\205\000\000\011\205\000\000\000\000\000\000\011\205\011\205\000\000\011\205\011\205\011\205\011\205\011\205\000\000\000\000\000\000\011\205\007%\000\000\011\205\007%\000\000\000\000\011\205\011\205\011\205\011\205\000\000\011\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007%\007%\011\205\007%\007%\000\000\000\000\000\000\000\000\011\205\011\205\011\205\011\205\011\205\000\000\000\000\000\000\000\000\006=\000\000\011\201\000\000\007%\000\000\011\201\011\201\000\000\011\201\011\201\000\000\000\000\000\000\000\000\011\201\000\000\000\000\011\205\011\205\006=\000\000\000\238\011\205\011\205\011\205\000\000\011\201\000\000\011\201\011\201\000\000\000\000\000\000\000\000\000\000\011\201\000\000\011\201\000\000\000\000\000\000\011\201\011\201\000\000\011\201\011\201\011\201\011\201\011\201\000\000\000\000\007%\011\201\007%\000\000\011\201\000\000\000\000\000\000\011\201\011\201\011\201\011\201\000\000\011\201\007%\000\000\000\000\005\166\007%\000\000\000\000\000\000\007%\011\201\007%\000\000\000\000\000\000\007%\000\000\011\201\011\201\011\201\011\201\011\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\000\000\000\000\000\246\000\000\000\000\001\250\012\t\012\t\000\000\000\000\000\000\012\t\011\201\011\201\012\t\017n\000\000\011\201\011\201\011\201\012I\0125\004*\000\000\012\t\012\t\012\t\000\000\012\t\012\t\000\000\017r\000\000\000\000\000\000\000\000\000\000\017\154\012I\000\000\012\t\000\000\000\000\000\000\002\006\000\000\012\t\012\t\000\000\016\202\012\t\002\154\000\000\000\000\016\226\012\t\000\000\002\014\012\t\000\000\002\018\0125\000\000\012\t\012\t\012\t\000\000\000\000\000\000\000\000\018\018\000\000\012\t\012\t\000\000\000\000\000\000\000\000\000\000\012\t\000\000\000\000\000\000\012\t\016\254\018&\012\t\000\000\000\000\004M\000\000\000\000\000\000\012\t\012\t\012\t\000\000\012\t\012\t\000\000\000\000\000\000\000\000\000\000\000\000\0186\007\145\012\t\000\006\012\t\012\t\007\145\002\134\002\138\012\t\002\182\002\194\000\000\000\000\012\t\000\000\002\198\000\000\012\t\000\000\012\t\012\t\000\000\014\"\000\000\000\000\000\000\000\000\002\202\000\000\003\n\003\014\000\000\000\000\000\000\000\000\000\000\003\018\000\000\002\206\000\000\000\000\000\000\003\150\003\154\007\145\003\158\002\250\003\170\003\178\006\142\000\000\000\000\007\145\002~\000\000\000\000\003\006\007\145\007\145\000\238\007\214\007\218\007\230\007\250\000\000\0056\007\145\007\145\001\181\000\000\000\000\000\000\000\000\001\181\000\000\bn\000\000\000\000\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\000\000\000\000\007\145\000\000\000\000\007\145\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\007\145\000\000\000\000\003\t\000\000\000\000\003\t\000\000\005J\007\238\000\000\001\181\000\000\b\006\004\018\b\250\003\t\003\t\003\t\001\181\003\t\003\t\000\000\000\000\001\181\001\181\000\238\000\000\000\000\000\000\000\000\000\000\003\t\001\181\001\181\000\000\000\000\000\000\003\t\004\"\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\001\181\000\000\000\000\000\000\000\000\003\t\003\t\000\000\000\000\001\181\000\000\000\000\003\t\000\000\ni\000\000\003\t\ni\000\000\003\t\003\"\002\138\000\000\000\000\002\194\000\000\003\t\003\t\003\t\002\198\003\t\003\t\000\000\ni\ni\000\000\ni\ni\000\000\000\000\003\t\000\000\003\t\003\t\003&\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\ni\003\t\0032\003\t\003\t\003>\001\170\003\133\012]\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\ni\003\186\000\000\003\194\005*\000\000\0056\000\000\003\133\000\000\000\000\000\000\003\133\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\005\134\ni\000\000\ni\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ni\000\000\000\000\ni\ni\000\000\005J\000\000\ni\000\000\ni\000\000\004\018\ne\ni\000\000\ne\000\000\000\000\003\"\002\138\012]\012]\002\194\000\000\006^\000\000\000\000\002\198\000\000\000\000\000\000\ne\ne\003\133\ne\ne\000\000\006~\000\000\012]\000\000\012]\003&\000\000\000\000\b\158\000\000\000\000\003\133\000\000\000\000\003\133\000\000\ne\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\ne\003\186\000\000\003\194\005*\nv\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004i\005:\000\000\000\000\000\000\018~\001\205\001\205\000\000\005B\005F\001\205\005\134\ne\001\205\ne\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\001\205\001\205\ne\001\205\001\205\ne\ne\000\000\005J\000\000\ne\000\000\ne\000\000\004\018\001\205\ne\000\000\000\000\018\170\000\000\001\205\001\205\000\000\000\000\001\205\000\000\016\202\000\000\000\000\001\205\000\000\016\226\001\205\000\000\000\000\000\000\000\000\001\205\001\205\001\205\000\000\018\230\000\000\000\000\000\000\000\000\001\205\001\205\000\000\000\000\000\000\000\000\000\000\001\205\000\000\003\"\002\138\001\205\000\000\002\194\001\205\006^\000\000\000\000\002\198\000\000\004i\001\205\001\205\001\205\000\000\001\205\001\205\000\000\006~\019Z\000\000\000\000\000\000\003&\000\000\001\205\b\158\001\205\001\205\000\000\000\000\000\000\001\205\000\000\000\000\000\000\0032\001\205\000\000\nf\001\170\004\190\000\000\001\205\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\nA\003\186\000\000\003\194\000\000\nv\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\000\000\n~\000\000\000\000\003\"\002\138\000\000\000\000\002\194\000\000\006^\000\000\000\000\002\198\000\000\nA\n\134\000\000\nA\n\242\000\000\005J\000\000\006~\000\000\nA\000\000\004\018\003&\nA\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\nf\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\nA\003\186\000\000\003\194\000\000\nv\0056\000\000\000\000\000\000\000\000\005)\005)\000\000\000\000\007\141\005)\000\000\005:\005)\007\141\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\005)\n~\005)\000\000\005)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nA\005)\000\000\nA\nA\000\000\005J\005)\005)\000\000\nA\000\000\004\018\005)\nA\007\141\005)\000\000\000\000\005)\000\000\000\000\000\000\007\141\005)\005)\005)\000\000\007\141\007\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\007\141\007\141\000\000\005)\005)\000\000\000\000\005)\000\000\000\000\000\000\000\000\001\006\000\000\000\000\000\000\000\000\005)\005)\005)\000\000\005)\005)\007\141\000\000\000\000\007\141\007.\001\n\000\000\000\000\000\000\000\000\000\000\005)\007\141\000\000\005)\005)\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\000\000\005)\000\000\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\000\000\000\000\001:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\000\000\000\000\000\000\001V\000\000\005\029\005\029\000\000\000\000\012y\005\029\000\000\001Z\005\029\012y\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\005\029\000\000\005\029\000\000\005\029\001\134\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\142\000\000\005\029\000\000\001\146\000\000\001\150\001\154\005\029\005\029\000\000\000\000\000\000\000\000\007\154\000\000\012y\005\029\000\000\000\000\005\029\000\000\000\000\000\000\012y\005\029\005\029\000\238\000\000\012y\012y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\005\029\005\029\003Q\003Q\005\029\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\000\000\005\029\005\029\005\029\000\000\005\029\005\029\003Q\000\000\003Q\012y\003Q\000\000\000\000\000\000\000\000\000\000\000\000\005\029\012y\000\000\005\029\005\029\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\000\000\000\000\005\029\000\000\004\233\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Q\000\000\000\000\000\000\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\003Q\003Q\b\001\b\001\000\000\000\000\004\233\b\001\000\000\000\000\b\001\000\000\000\000\003Q\000\000\000\000\000\000\003Q\000\000\000\000\b\001\000\000\b\001\000\000\b\001\000\000\000\000\000\000\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\001\000\000\000\000\000\000\000\000\000\000\b\001\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\001\000\000\000\000\b\001\000\000\000\000\000\000\000\000\b\001\b\001\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\001\000\000\012\185\012\185\b\001\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\b\001\b\001\b\001\000\000\b\001\b\001\012\185\000\000\012\185\000\000\012\185\000\000\000\000\000\000\b\001\000\000\000\000\b\001\000\000\000\000\000\000\b\001\012\185\000\000\000\000\000\000\000\000\000\000\012\185\012\185\004\190\000\000\b\001\000\000\0042\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\000\000\012\185\012\185\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\185\000\000\000\000\000\000\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\185\012\185\012\185\000\000\012\185\012\185\012\189\012\189\000\000\000\000\004B\012\189\000\000\000\000\012\189\000\000\000\000\012\185\000\000\000\000\000\000\012\185\000\000\000\000\012\189\000\000\012\189\000\000\012\189\000\000\000\000\000\000\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\000\000\000\000\012\189\012\189\000\000\000\000\000\000\000\000\0042\000\000\000\000\012\189\000\000\000\000\012\189\000\000\000\000\000\000\000\000\012\189\012\189\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\012\189\012\189\000\000\012\189\012\189\003Q\003Q\000\000\000\000\004B\003Q\000\000\000\000\003Q\000\000\000\000\012\189\000\000\000\000\000\000\012\189\000\000\000\000\003Q\000\000\003Q\000\000\003Q\000\000\000\000\000\000\012\189\001\182\001\186\000\000\000\000\000\000\000\000\000\000\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\000\000\000\000\000\000\001\190\004\237\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\222\002n\000\000\000\000\000\000\002j\003Q\002~\003\234\003\246\003Q\000\000\000\000\000\000\004\002\000\000\b\133\000\000\000\000\000\000\003Q\003Q\003Q\000\000\003Q\003Q\000\000\000\000\000\000\000\000\004\237\004\006\t\130\000\000\004\189\014\022\000\000\003Q\b\133\000\000\000\000\003Q\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\025\210\000\000\003Q\000\000\000\000\000\000\000\000\000\000\t\234\t\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\006\153\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\006\153\000\000\000\000\000\000\006\153\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\b\133\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\001\189\000\000\000\000\006\153\n\"\001\189\000\000\001\186\001\189\000\000\000\000\000\000\000\000\n*\000\000\000\000\ba\000\000\001\189\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\000\000\000\000\000\000\001\189\000\000\n2\000\000\012!\000\000\001\189\001\189\000\000\012!\n:\nB\012!\002f\000\000\001\189\000\000\000\000\001\189\000\000\000\000\000\000\012!\001\189\001\189\001\189\012!\000\000\000\000\0035\000\000\000\000\012)\000\000\0035\000\000\001\186\0035\012!\001\189\001\189\000\000\000\000\004Z\012!\b]\000\000\0035\000\000\000\000\000\000\0035\000\000\001\189\001\189\000\000\012!\001\189\001\189\000\000\000\000\012!\012!\0035\000\000\000\000\000\000\001\189\000\000\0035\001\185\000\000\000\000\000\000\001\189\000\000\002f\012!\0035\001\189\000\000\0035\000\000\000\000\000\000\001\189\0035\0035\0035\000\000\000\000\012!\012!\002F\000\000\012!\012!\000\000\000\000\000\000\000\000\000\000\0035\0035\000\000\012!\004Z\000\000\000\000\026F\000\000\000\000\012!\000\000\000\000\016\026\0035\0035\000\000\000\000\0035\0035\000\000\012!\000\000\000\000\000\000\000\000\000\000\000\000\0035\t\130\000\000\000\000\000\000\016\030\000\000\0035\000\000\000\000\000\000\000\000\0035\t\186\t\210\t\218\t\194\t\226\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\149\000\000\000\000\000\000\000\000\000\149\n\"\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\n*\000\000\000\000\000\149\000\000\000\149\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\nJ\016\"\nR\n\018\0162\000\149\000\000\000\000\000\000\n2\000\000\000\149\000\000\000\000\000\000\000\149\000\000\n:\nB\000\000\000\149\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\149\000\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\000\000\000\000\217\000\149\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\149\000\149\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\217\000\000\000\217\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\149\000\000\000\149\000\217\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\217\000\217\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\157\000\217\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\217\000\217\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\217\000\000\000\217\000\157\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\153\000\157\000\000\000\000\000\000\000\153\000\000\000\000\000\153\000\000\000\000\000\157\000\157\000\000\000\000\000\157\000\157\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\153\006u\006u\000\000\000\000\000\000\000\153\000\157\000\000\000\157\000\153\000\000\000\000\000\000\000\000\000\153\000\000\003\250\000\153\006u\006u\000\000\000\000\000\153\000\153\000\238\000\000\000\000\006u\001\129\000\000\000\000\000\153\000\153\001\129\000\000\000\000\001\129\000\000\000\153\000\000\006u\006u\000\153\000\000\000\000\006u\001\129\006u\006u\006u\001\129\000\000\000\153\000\153\006u\000\000\000\153\000\153\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\153\000\000\001\129\000\000\000\000\006u\000\153\000\153\004\233\000\000\000\000\001\129\000\000\000\000\001\129\000\000\000\153\000\000\000\153\001\129\001\129\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001\129\000\000\003\238\000\000\006u\000\000\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\001\129\001\129\000\000\012\181\012\181\000\000\004\233\000\000\012\181\000\000\001\129\012\181\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\000\012\181\001\129\012\181\000\000\012\181\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\000\000\000\000\000\000\000\000\012\181\012\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\000\000\012\181\000\000\000\000\000\000\000\000\012\181\012\181\012\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\012\177\012\177\012\181\000\000\000\000\012\177\000\000\000\000\012\177\000\000\000\000\000\000\012\181\012\181\012\181\000\000\012\181\012\181\012\177\000\000\012\177\000\000\012\177\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\000\000\000\000\012\181\012\177\000\000\000\000\000\000\000\000\000\000\012\177\012\177\004\190\000\000\012\181\000\000\000\000\000\000\000\000\012\177\000\000\000\000\012\177\000\000\000\000\000\000\000\000\012\177\012\177\012\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\177\000\000\b\005\b\005\012\177\000\000\000\000\b\005\000\000\000\000\b\005\000\000\000\000\000\000\012\177\012\177\012\177\000\000\012\177\012\177\b\005\000\000\b\005\000\000\b\005\000\000\000\000\000\000\007\n\000\000\000\000\012\177\000\000\000\000\000\000\012\177\b\005\000\000\000\000\000\000\000\000\000\000\b\005\b\005\000\000\000\000\012\177\000\000\000\000\000\000\000\000\b\005\000\000\000\000\b\005\000\000\000\000\000\000\000\000\b\005\b\005\000\238\000\000\000\000\000\000\001\185\000\000\000\000\000\000\000\000\001\185\000\000\001\186\001\185\000\000\b\005\000\000\000\000\000\000\b\005\000\000\b]\000\000\001\185\000\000\000\000\000\000\001\185\000\000\b\005\b\005\b\005\000\000\b\005\b\005\000\000\000\000\000\000\000\000\001\185\000\000\000\000\000\000\b\005\000\000\001\185\b\005\000\000\000\000\000\000\b\005\000\000\002f\000\000\001\185\000\000\000\000\001\185\000\000\000\000\000\000\b\005\001\185\001\185\001\185\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001i\000\000\012)\001i\000\000\001\185\001\185\000\000\000\000\004Z\000\000\012)\000\000\001i\000\000\001i\000\000\001i\000\000\001\185\001\185\000\000\000\000\001\185\001\185\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\001\185\000\000\001i\012)\000\000\000\000\000\000\001\185\000\000\012)\000\000\000\000\001\185\000\000\001i\000\000\000\000\000\000\001\185\001i\001i\001i\000\000\000\000\000\000\005M\005M\000\000\000\000\000\000\005M\000\000\000\000\005M\000\000\001i\000\000\000\000\000\000\012)\000\000\000\000\000\000\005M\000\000\005M\000\000\005M\000\000\001i\001i\001i\000\000\001i\001i\000\000\000\000\000\000\000\000\005M\000\000\000\000\000\000\000\000\000\000\005M\005M\000\000\000\000\019\226\001i\007\154\000\000\000\000\005M\000\000\000\000\005M\000\000\000\000\000\000\001i\005M\005M\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005M\000\000\005I\006\222\005M\000\000\000\000\005I\000\000\000\000\005I\000\000\000\000\000\000\005M\005M\005M\000\000\005M\005M\005I\000\000\005I\000\000\005I\000\000\000\000\000\000\000\000\000\000\000\000\005M\000\000\000\000\000\000\005M\005I\000\000\000\000\000\000\000\000\000\000\005I\007J\000\000\000\000\005M\000\000\000\000\000\000\000\000\005I\000\000\000\000\005I\000\000\000\000\000\000\000\000\005I\005I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005I\000\000\005e\005e\005I\000\000\000\000\005e\000\000\000\000\005e\000\000\000\000\000\000\005I\005I\005I\000\000\005I\005I\005e\000\000\005e\000\000\005e\000\000\000\000\000\000\000\000\000\000\000\000\005I\000\000\000\000\000\000\005I\005e\000\000\000\000\000\000\000\000\000\000\005e\005e\000\000\000\000\005I\000\000\000\000\000\000\000\000\005e\000\000\000\000\005e\000\000\000\000\000\000\000\000\005e\005e\005e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005e\000\000\005a\006\222\005e\000\000\000\000\005a\000\000\000\000\005a\000\000\000\000\000\000\005e\005e\005e\000\000\005e\005e\005a\000\000\005a\000\000\005a\000\000\000\000\000\000\000\000\000\000\000\000\005e\000\000\000\000\000\000\005e\005a\000\000\000\000\000\000\000\000\000\000\005a\007J\000\000\000\000\007B\000\000\000\000\000\000\000\000\005a\000\000\000\000\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\004E\000\000\000\000\000\000\000\000\004E\003\"\002\138\004E\000\000\002\194\000\000\006^\005a\000\000\002\198\000\000\005a\004E\000\000\000\000\000\000\004E\000\000\000\000\006~\000\000\005a\005a\005a\003&\005a\005a\b\158\004E\000\000\000\000\000\000\000\000\000\000\004E\000\000\000\000\0032\005a\000\000\nf\001\170\005a\004E\000\000\011\206\004E\002~\000\000\000\000\003\182\004E\002\174\005a\003\186\000\000\003\194\000\000\nv\0056\000\000\t\130\000\000\000\000\000\000\000\000\000\000\004E\011\210\000\000\000\000\005:\000\000\t\186\t\210\t\218\t\194\t\226\000\000\005B\005F\004E\004E\n~\000\000\004E\004E\t\234\t\242\000\000\011\230\007.\000\000\000\000\000\000\000\000\t\250\000\000\n\134\000\000\000\000\n\146\004E\005J\000\238\000\000\t\130\020\234\000\000\004\018\011\234\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\011\246\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\011\250\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012\006\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012\n\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\012&\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\t\130\000\000\000\000\000\000\012*\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\012>\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\012B\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012V\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012Z\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\011\206\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012\154\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\011\230\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\t\130\000\000\000\000\000\000\012\182\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\011\246\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\012\202\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012\006\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012\222\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\012&\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\t\130\000\000\000\000\000\000\r\014\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\012>\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\r\026\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012V\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\r&\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\0031\000\000\000\000\000\000\n\"\0031\000\000\001\186\0031\000\000\000\000\000\000\000\000\n*\000\000\000\000\000\000\000\000\0031\000\000\000\000\000\000\0031\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\000\000\000\000\000\000\0031\000\000\n2\000\000\000\000\000\000\0031\000\000\000\000\000\000\n:\nB\000\000\002f\000\000\0031\000\000\000\000\0031\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\000\000\000\000\004Z\n\138\000\000\000\000\000\000\000\000\000\246\001\182\001\186\001\250\0031\0031\000\000\000\000\0031\0031\000\000\000\000\000\000\017n\000\000\000\000\000\000\004M\0031\001\190\001\206\000\000\000\000\000\000\000\000\0031\000\000\000\000\001\218\017r\0031\000\000\000\000\000\000\000\000\017\154\0031\000\000\000\000\000\000\006\253\001\222\002^\006\253\000\000\000\000\002j\016\202\002~\003\234\003\246\000\000\016\226\0011\000\000\004\002\000\000\000\000\0011\006\253\006\253\0011\006\253\006\253\000\000\000\000\000\000\000\000\018\018\000\000\000\000\0011\004\006\0011\000\000\0011\000\000\000\000\000\000\000\000\000\000\006\253\016\254\018&\000\000\000\000\000\000\0011\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\000\000\0011\000\000\006\253\000\000\000\000\0011\0186\000\000\0011\000\000\000\000\000\000\000\000\0011\0011\000\238\000\000\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\000\000\000\000\001-\000\000\0011\000\000\000\000\006\253\0011\006\253\000\000\000\000\001-\000\000\001-\000\000\001-\000\000\0011\0011\0011\006\253\0011\0011\005\166\006\253\000\000\000\000\001-\006\253\000\000\006\253\0011\000\000\001-\006\253\000\000\000\000\001-\0011\000\000\000\000\000\000\001-\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\001-\000\238\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\000\000\012-\001m\000\000\001-\000\000\000\000\000\000\001-\000\000\012-\000\000\001m\000\000\001m\000\000\001m\000\000\001-\001-\001-\000\000\001-\001-\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\000\000\001m\012-\000\000\000\000\000\000\001-\000\000\012-\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\001m\001m\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\029\000\000\000}\001\029\000\000\001m\000\000\000\000\000\000\012-\000\000\000}\000\000\001\029\000\000\001\029\000\000\001\029\000\000\001m\001m\001m\000\000\001m\001m\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\000}\000\000\000\000\000\000\001m\000\000\000}\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\001m\001\029\001\029\001\029\001\197\000\000\000\000\000\000\000\000\001\197\000\000\0156\001\197\000\000\002N\000\000\000\000\001\029\000\000\000\000\000\000\000}\001\197\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\001\197\001\182\001\186\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\015:\000\000\001\029\001\197\000\000\015J\001\197\001\190\001\206\000\000\000\000\001\197\001\197\001\029\015F\000\000\001\218\000\000\000\000\000\000\000\000\000\000\000\000\001\226\000\000\000\000\000\000\001\197\0009\001\222\002^\001\197\000\000\0009\002j\0009\002~\003\234\003\246\000\000\015N\001\197\001\197\004\002\0009\001\197\001\197\0009\000\000\000\000\000\000\0009\b!\000\000\000\000\001\197\000\000\000\000\000\000\000\000\004\006\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\0009\001\197\000\000\0009\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\0009\0009\0009\000\000\000\000\000\000\000\000\000\000\000\000\0009\0009\004\014\000\000\004\018\000\000\003\"\002\138\000\000\000\000\002\194\0009\006^\000\000\0009\002\198\000\000\000\000\000\000\004E\000\000\000\000\004E\0009\000\000\006~\0009\000\000\000\000\000\000\003&\b!\004E\b\158\000\000\0009\000\000\000\000\0009\000\000\000\000\b\226\000\000\0032\000\000\000\000\rN\001\170\004E\000\000\000\000\0009\000\000\002~\004E\000\000\003\182\000\000\000\000\000\000\003\186\004E\003\194\004E\nv\0056\004E\000\000\000\000\004E\000\000\004E\002\174\000\000\000\000\000\000\000\000\005:\000\000\004E\000\000\000\000\000\000\004E\000\000\005B\005F\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\000\000\r^\000\000\005J\004E\000\000\000\000\004E\000\000\004\018\000\000\000\000\004E\002\174\000\238\000\000\004E\000\000\003)\000\000\000\000\004E\004E\003)\000\000\000\000\003)\000\000\004E\004E\000\000\000\000\004E\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\000\000\000\000\003)\015V\000\000\000\000\004E\000\000\003)\000\000\000\000\004E\000\000\004E\004E\000\000\000\000\003)\025N\000\000\003)\000\000\000\000\000\000\004E\003)\003)\003)\004E\000\000\003\"\002\138\000\000\000\000\002\194\000\000\006^\000\000\000\000\002\198\004E\003)\000\000\000\000\000\000\003)\004E\000\000\000\000\006~\000\000\000\000\0042\000\000\003&\003)\003)\b\158\004E\003)\003)\000\000\000\000\004E\002\174\023\018\000\000\0032\000\000\003)\003>\001\170\000\000\000\000\000\000\015\182\003)\002~\000\000\004E\003\182\003)\000\000\000\000\003\186\000\000\003\194\003)\nv\0056\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\005:\000\000\004B\000\000\000\000\000\000\007\n\000\000\005B\005F\003\"\002\138\021\130\004E\002\194\000\000\006^\000\000\000\000\002\198\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\006~\023\222\000\000\005J\000\000\003&\000\000\000\000\b\158\004\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\nf\001\170\000\000\000\000\000\000\000\000\000\000\002~\006q\006q\003\182\000\000\000\000\000\000\003\186\000\000\003\194\000\000\nv\0056\000\000\000\000\000\000\000\000\000\000\000\000\006q\006q\000\000\000\000\000\000\005:\000\000\000\000\000\000\006q\000\000\000\000\000\000\005B\005F\003\"\002\138\n~\000\000\002\194\000\000\006^\006q\006q\002\198\000\000\000\000\006q\000\000\006q\006q\006q\000\000\000\000\006~\022\026\006q\005J\000\000\003&\000\000\000\000\b\158\004\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\006q\000\000\nf\001\170\005~\000\000\000\000\000\000\000\000\002~\003\"\002\138\003\182\000\000\002\194\000\000\003\186\000\000\003\194\002\198\nv\0056\000\000\000\000\005\130\000\000\003\190\000\000\000\000\000\000\000\000\000\000\000\000\005:\003&\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\004\166\000\000\n~\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\022z\003\186\005J\003\194\005*\000\000\0056\000\000\004\018\000\000\000\000\000\000\000\000\000\000\000\000\b\161\000\000\000\000\005:\000\000\000\000\003\"\002\138\000\000\000\000\002\194\005B\005F\000\000\005\134\002\198\000\000\000\000\000\000\000\000\000\000\000\000\b\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003&\000\000\005\206\000\000\000\000\005J\000\000\006J\000\000\b\134\000\000\004\018\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\011\233\000\000\003\186\011\233\003\194\005*\000\000\0056\002\209\002\209\000\000\000\000\002\209\011\233\000\000\000\000\000\000\002\209\000\000\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\011\233\005\134\000\000\002\209\000\n\000\000\011\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\233\002\209\000\000\011\233\002\209\002\209\000\000\005J\011\233\b\161\000\000\002\209\000\000\004\018\002\209\000\000\000\000\002\209\002\209\000\000\002\209\002\209\000\000\002\209\011\233\004-\004-\000\000\011\233\004-\000\000\000\000\000\000\000\000\004-\002\209\000\000\000\000\011\233\011\233\004-\000\000\011\233\002\209\002\209\000\000\002\209\000\000\027J\004-\022\202\000\000\000\000\022\226\000\000\000\000\000\000\000\000\000\000\011\233\000\000\000\000\004-\000\000\000\000\004-\004-\002\209\000\000\000\000\000\000\002\209\004-\002\209\000\000\004-\000\000\000\000\000\238\004-\003)\004-\004-\000\000\004-\003)\000\000\000\000\003)\003)\000\000\000\000\000\000\000\000\003)\000\000\004-\003)\003)\000\000\000\000\000\000\003)\000\000\004-\004-\000\000\003)\000\000\000\000\000\000\003)\000\000\000\000\003)\015V\000\000\000\000\000\000\000\000\003)\000\000\000\000\003)\015V\000\000\000\000\000\000\004-\003)\000\000\000\000\003)\000\000\004-\000\000\000\000\003)\003)\003)\003)\003)\000\000\000\000\000\000\003)\003)\003)\003)\000\000\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\003)\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\003)\003)\025V\000\000\003)\003)\000\000\003)\015V\003)\003)\025\134\000\000\003)\003)\000\000\000\000\000\000\000\000\012!\015\182\003)\003)\000\000\012!\003)\003)\012!\000\000\015\182\003)\003)\003)\000\000\000\000\003)\000\000\012!\000\000\000\000\000\000\012!\000\000\000\000\000\000\000\000\003)\012)\000\000\000\000\003)\000\000\000\000\012!\000\000\000\000\000\000\000\000\000\000\012!\003)\003)\017:\000\000\003)\003)\000\000\000\000\012!\000\000\000\000\012!\000\000\000\000\000\000\000\000\012!\012!\003\"\002\138\015\182\003)\002\194\000\000\006^\000\000\000\000\002\198\000\000\000\000\000\000\000\000\012!\000\000\000\000\000\000\012!\006~\000\000\000\000\000\000\000\000\003&\000\000\000\000\b\158\012!\012!\002F\000\000\012!\012!\000\000\000\000\000\000\0032\000\000\000\000\b\202\001\170\012!\005\001\000\000\000\000\026~\002~\005\001\012!\003\182\005\001\000\000\000\000\003\186\000\000\003\194\000\000\nv\0056\012!\005\001\000\000\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\000\000\000\000\005\001\000\000\005B\005F\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\007\154\000\000\000\000\005\001\000\000\000\000\005\001\000\000\000\000\000\000\000\000\005\001\005\001\000\238\005J\000\000\000\000\005\005\000\000\000\000\004\018\000\000\005\005\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\000\000\000\000\000\000\005\005\000\000\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\005\001\000\000\000\000\000\000\000\000\005\005\012\193\012\193\000\000\000\000\000\000\005\005\000\000\000\000\000\000\000\000\005\001\007\154\000\000\000\000\005\005\000\000\000\000\005\005\012\193\012\193\006\242\005\001\005\005\005\005\000\238\000\000\000\000\012\193\005\169\000\000\000\000\000\000\000\000\005\169\000\000\000\000\005\169\000\000\005\005\005\005\012\193\012\193\005\005\000\000\000\000\012\193\005\169\012\193\012\193\012\193\005\169\000\000\005\005\005\005\012\193\000\000\005\005\005\005\000\000\000\000\000\000\000\000\005\169\000\000\000\000\000\000\000\000\000\000\005\169\000\000\000\000\012\193\000\000\005\005\000\000\000\000\000\000\005\169\000\000\000\000\005\169\000\000\000\000\000\000\005\005\005\169\005\169\000\238\025.\000\000\000\000\000\000\000\000\000\000\003\"\002\138\000\000\000\000\002\194\000\000\000\000\005\169\000\000\002\198\000\000\005\169\000\000\000\000\000\000\000\000\006\n\000\000\000\000\000\000\000\000\005\169\005\169\021\014\003&\005\169\005\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\169\000\000\0032\000\000\000\000\003>\001\170\005\169\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\005\169\003\186\000\000\003\194\005*\005\241\0056\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\194\000\000\000\000\005:\000\000\002\198\000\000\000\000\000\000\000\000\005\241\005B\005F\000\000\005\134\000\000\000\000\002\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\206\000\000\000\000\000\000\000\000\000\000\000\000\005J\002\250\001\170\000\000\b\134\000\000\004\018\000\000\002~\000\000\000\000\003\006\001\182\001\186\000\000\007\214\007\218\007\230\000\000\000\000\0056\000\000\000\000\000\000\000\000\000\000\002Z\000\000\005\170\000\000\001\190\001\206\000\000\000\000\003\"\002\138\000\000\000\000\002\194\001\218\005B\005F\000\000\002\198\000\000\000\000\001\226\000\000\000\000\000\000\000\000\000\000\001\222\002^\000\000\000\000\000\000\002j\003&\002~\003\234\003\246\000\000\000\000\005J\007\238\004\002\000\000\000\000\b\006\004\018\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\005\230\000\000\002~\000\000\004\006\003\182\003\"\002\138\000\000\003\186\002\194\003\194\005*\000\000\0056\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\003&\000\000\000\000\015>\005B\005F\000\000\005\134\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\005J\000\000\003\186\005\242\003\194\005*\004\018\0056\000\000\003\"\002\138\000\000\000\000\002\194\000\000\000\000\000\000\000\000\002\198\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\005\134\000\000\000\000\003&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\005J\000\000\000\000\005\245\000\000\002~\004\018\000\000\003\182\003\"\002\138\000\000\003\186\002\194\003\194\005*\000\000\0056\002\198\000\000\000\000\000\000\000\000\005\245\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\003&\000\000\000\000\000\000\005B\005F\000\000\005\134\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\005J\000\000\003\186\011^\003\194\005*\004\018\0056\000\000\003\"\002\138\000\000\000\000\002\194\000\000\000\000\000\000\000\000\002\198\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\000\000\000\000\000\000\003&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\005J\000\000\000\000\011j\000\000\002~\004\018\000\000\003\182\003\"\002\138\000\000\003\186\002\194\003\194\005*\000\000\0056\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\003&\000\000\000\000\000\000\005B\005F\000\000\005\134\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\005J\000\000\003\186\011v\003\194\005*\004\018\0056\000\000\003\"\002\138\000\000\000\000\002\194\006\025\000\000\000\000\000\000\002\198\005:\000\000\002\138\000\000\000\000\002\194\000\000\000\000\005B\005F\002\198\005\134\000\000\000\000\003&\006\025\000\000\000\000\000\000\000\000\000\000\000\000\002\202\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\005J\002\206\000\000\000\000\000\000\002~\004\018\000\000\003\182\002\250\001\170\000\000\003\186\000\000\003\194\005*\002~\0056\000\000\003\006\000\000\000\000\000\000\007\214\007\218\007\230\000\000\000\000\0056\005:\000\000\000\000\000\000\000\000\006\161\006\222\000\000\005B\005F\006\161\005\134\000\000\006\161\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\000\000\000\000\000\000\005J\000\000\000\000\000\000\000\000\000\000\004\018\006\161\000\000\000\000\000\000\005J\007\238\006\161\007J\000\000\b\006\004\018\001\153\000\000\000\000\000\000\006\161\001\153\000\000\006\161\001\153\000\000\000\000\000\000\006\161\006\161\000\238\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\153\000\000\000\000\000\000\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\001\153\000\000\000\000\000\000\000\000\000\000\001\153\000\000\006\161\006\161\000\000\000\000\006\161\006\161\000\000\001\153\000\000\000\000\001\153\000\000\000\000\000\000\000\000\001\153\001\153\001\153\001\201\000\000\005\173\006\161\000\000\001\201\000\000\005\173\001\201\000\000\005\173\000\000\000\000\001\153\000\000\000\000\000\000\001\153\001\201\000\000\005\173\000\000\001\201\000\000\005\173\000\000\000\000\001\153\001\153\000\000\000\000\001\153\001\153\000\000\001\201\000\000\005\173\017J\000\000\000\000\001\201\000\000\005\173\000\000\000\000\000\000\000\000\000\000\001\153\001\201\000\000\005\173\001\201\001\153\005\173\000\000\000\000\001\201\001\201\005\173\005\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\000\000\005\173\000\000\001\201\000\000\005\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\001\201\005\173\005\173\001\201\001\201\005\173\005\173\000\000\000\000\000\000\000\000\000\000\000\000\001\201\011\217\005\173\002\138\011\217\000\000\0272\001\201\000\000\005\173\000\000\0276\020\234\000\000\011\217\000\000\000\000\000\000\001\201\000\000\005\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\217\000\000\000\000\000\000\000\000\000\000\011\217\000\000\000\000\000\000\000\000\004E\001\002\001\170\000\000\011\217\004E\000\000\011\217\004E\000\000\000\000\000\000\011\217\000\000\000\000\000\000\000\000\000\000\004E\000\000\027:\000\000\004E\000\000\000\000\000\000\000\000\000\000\011\217\000\000\000\000\000\000\011\217\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\027>\011\217\011\217\000\000\000\000\011\217\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\000\000\004E\002\174\000\000\000\000\000\000\000\000\011\217\000\000\000\000\007\193\007\193\000\000\000\000\007\193\000\000\000\000\004E\000\000\007\193\000\000\004E\000\000\000\000\000\000\015\226\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\007\193\004E\004E\006\222\000\000\000\000\000\000\004E\000\000\000\000\004E\007\n\000\000\007\193\000\000\000\000\007\193\007\193\004E\004E\004E\000\000\000\000\007\193\004E\000\000\007\193\004E\000\000\004E\007\193\000\000\007\193\007\193\000\000\007\193\004E\004E\000\000\000\000\000\000\004E\004E\007J\000\000\000\000\000\000\007\193\000\000\000\000\000\000\000\000\000\000\004E\004E\007\193\007\193\000\000\000\000\004E\002\174\000\238\000\000\000\000\000\000\007\154\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\004E\004E\002\174\000\238\007\193\000\000\000\000\000\000\001U\000\000\007\193\000\000\000\000\001U\004E\004E\001U\004E\004E\004E\000\000\004E\000\000\000\000\000\000\000\000\001U\000\000\001U\000\000\001U\004E\004E\000\000\000\000\004E\004E\001\182\001\186\022\030\000\000\000\000\001U\000\000\000\000\000\000\004E\000\000\001U\000\000\000\000\000\000\004E\000\205\000\000\002v\001\206\000\000\000\205\000\000\001U\000\205\000\000\000\000\001\218\001U\001U\000\238\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\205\000\000\001\222\002^\000\000\000\000\001U\002j\000\000\002~\003\234\003\246\000\205\000\000\000\000\000\000\004\002\000\000\000\205\000\000\001U\001U\001U\000\000\001U\001U\000\000\000\205\000\000\000\000\000\205\000\000\000\000\004\006\000\000\000\205\000\205\000\238\000\000\000\000\000\000\001U\000\209\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\000\205\001U\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\205\000\205\000\000\000\000\000\205\000\205\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\000\000\000\000\000\205\000\000\000\209\000\209\000\238\000\000\000\000\001\182\002J\000\000\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\000\000\000\001\190\001\206\002R\000\000\000\000\000\000\000\000\000\209\000\209\001\218\000\000\000\209\000\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002V\002^\000\000\000\000\000\000\002j\000\209\002~\003\234\003\246\000\000\000\000\000\000\000\000\020\194\000\000\020\198\000\209\000\000\006\157\000\000\000\000\000\000\000\000\006\157\000\000\000\000\006\157\000\000\000\000\000\000\004\006\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\015N\006\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\210\000\000\000\000\006\157\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\000\000\000\000\005\161\000\000\000\000\020\214\006\157\005\161\000\000\006\157\005\161\000\000\000\000\000\000\006\157\006\157\000\000\017\026\000\000\000\000\005\161\000\000\000\000\000\000\005\161\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\000\000\006\157\000\000\005\161\000\000\000\000\000\000\000\000\000\000\005\161\000\000\006\157\006\157\016z\000\000\006\157\006\157\000\000\005\161\000\000\000\000\005\161\000\000\000\000\000\000\000\000\005\161\005\161\000\000\005\r\006\222\000\000\006\157\000\000\005\r\000\000\000\000\005\r\000\000\000\000\000\000\000\000\005\161\000\000\000\000\000\000\005\161\005\r\000\000\000\000\000\000\005\r\000\000\000\000\000\000\000\000\005\161\005\161\000\000\000\000\005\161\005\161\000\000\005\r\000\000\000\000\000\000\000\000\000\000\005\r\007J\000\000\000\000\000\000\011\137\000\000\000\000\005\161\000\000\011\137\000\000\005\r\011\137\000\000\000\000\000\000\005\r\005\r\000\238\000\000\000\000\000\000\011\137\000\000\000\000\000\000\011\137\000\000\000\000\000\000\000\000\000\000\005\r\000\000\000\000\000\000\000\000\000\000\011\137\000\000\000\000\000\000\000\000\000\000\011\137\000\000\005\r\005\r\000\000\000\000\005\r\005\r\000\000\011\137\000\000\000\000\011\137\000\000\000\000\000\000\000\000\011\137\000\000\000\000\000\000\000\000\000\000\005\r\000\000\000\000\001\182\002J\000\000\000\000\002N\000\000\000\000\011\137\tv\000\000\000\000\011\137\004\029\000\000\000\000\000\000\000\000\004\029\001\190\001\206\004\029\011\137\011\137\000\000\000\000\011\137\011\137\001\218\000\000\000\000\004\029\000\000\000\000\000\000\004\029\000\000\000\000\000\000\000\000\000\000\002V\002^\011\137\000\000\000\000\002j\004\029\002~\003\234\003\246\000\000\000\000\004\029\nZ\020\194\000\000\026*\004\021\000\000\000\000\000\000\004\029\004\021\000\000\004\029\004\021\000\000\000\000\000\000\004\029\000\000\004\006\000\000\000\000\000\000\004\021\000\000\000\000\000\000\004\021\015N\000\000\000\000\000\000\000\000\004\029\000\000\000\000\000\000\004\029\0266\004\021\000\000\000\000\000\000\000\000\000\000\004\021\000\000\004\029\004\029\000\000\000\000\004\029\004\029\000\000\004\021\020\214\000\000\004\021\000\000\000\000\000\000\000\000\004\021\000\000\000\000\0045\000\000\000\000\004\029\000\000\0045\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\021\016\174\000\000\000\000\004\021\0045\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\021\004\021\000\000\000\000\004\021\004\021\000\000\0045\000\000\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\005\000\000\000\000\004\021\0045\004\005\000\000\0045\004\005\000\000\000\000\000\000\0045\000\000\019\158\000\000\000\000\000\000\004\005\000\000\000\000\000\000\004\005\000\000\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\0045\000\000\004\005\000\000\000\000\000\000\000\000\000\000\004\005\000\000\0045\0045\000\000\007)\0045\0045\007)\004\005\000\000\000\000\004\005\000\000\000\000\000\000\000\000\004\005\000\000\000\000\000\000\000\000\000\000\0045\007)\007)\000\000\007)\007)\000\000\000\000\000\000\000\000\004\005\020\134\000\000\007\025\004\005\000\000\007\025\000\000\000\000\000\000\001\182\001\186\022~\007)\004\005\004\005\000\000\000\000\004\005\004\005\000\000\000\000\007\025\007\025\000\000\007\025\007\025\000\000\002v\001\206\000\000\000\238\000\000\000\000\004%\004\005\000\000\001\218\000\000\004%\000\000\000\000\004%\000\000\007\025\000\000\023\254\000\000\000\000\000\000\001\222\002^\004%\000\000\000\000\002j\004%\002~\003\234\003\246\000\000\007)\000\238\007)\004\002\000\000\000\000\000\000\004%\000\000\000\000\000\000\000\000\000\000\004%\007)\000\000\000\000\005\166\007)\000\000\004\006\000\000\007)\000\000\007)\004%\000\000\000\000\007)\000\000\004%\007\025\004\r\007\025\004=\000\000\000\000\004\r\000\000\004=\004\r\000\000\004=\000\000\000\000\005\226\004%\000\000\005\166\007\025\004\r\000\000\004=\007\025\004\r\007\025\004=\000\000\000\000\007\025\004%\004%\000\000\000\000\004%\004%\004\r\000\000\004=\000\000\000\000\000\000\004\r\000\000\004=\000\000\000\000\000\000\000\000\000\000\000\000\004%\000\000\000\000\004\r\000\000\004=\000\000\000\000\004\r\000\000\004=\017\242\004M\000\000\004Y\000\000\000\000\000\246\000\000\000\246\001\250\000\000\002\142\000\000\004\r\000\000\004=\000\000\000\000\000\000\017n\000\000\003v\000\000\004M\000\000\004Y\000\000\004\r\004\r\004=\004=\004\r\004\r\004=\004=\017r\000\000\003z\000\000\000\000\000\000\017\154\000\000\016f\000\000\000\000\000\000\000\000\004\r\000\000\004=\000\000\024*\016\202\000\000\016\202\000\000\000\000\016\226\0202\016\226\020\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\150\000\000\018\018\000\000\016\234\000\000\001\182\001\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\254\018&\016\254\017*\004M\004M\004Y\004Y\001\190\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\218\n\226\000\000\000\000\0186\000\000\021j\001\182\001\186\000\000\000\000\000\000\000\000\001\222\002^\000\000\000\246\000\000\002j\002\142\002~\003\234\003\246\000\000\000\000\001\190\001\206\004\002\000\000\027~\000\000\000\000\000\000\000\000\001\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\006\003z\000\000\001\222\002^\000\000\000\000\016f\002j\000\000\002~\003\234\003\246\000\000\000\000\000\000\024*\004\002\000\000\016\202\000\000\000\000\000\000\000\000\016\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\006\000\000\000\000\000\000\000\000\000\000\016\234\000\000\000\000\000\000\027*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\254\017*\000\000\000\000\004\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021j"))
+ ((16, "C\134O\006B\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\240B\154\000\000\000\000\020\004B\154C\134\025\128\005\162\003$YJ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\005B\000|\000\000\001r\000\b\000\000\001j\001|\000\252\000\000\006.\002\b\005\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\244\000\000\000\000\000\000\001vd\250\000\000\000\000\0032\000\000\000\000\000\000\003J\003B\000\000\000\000m\128N\200\020\004A\028Z\132\020\004R\154O\006\020\004Lj\000\000\021P\000\000\021P\000\007\000\000\0032\000\000\000\000\000\000\003\014\000\000\021P\000\000\004&^\208Y\002b\136\000\000\128\252wd\000\000J\136D8\000\000I*\027:M \0032m\218B\154C\134\000\000\000\000O\006\020\004R\188\021P\005|t>\000\000|\194B\154C\134O\006\020\004\000\000\000\000\000\000\0164\020\184\000V\007\174\000\000\003\180\bR\000\000\000\000\000\000\020\004\000\000@\190\000\000v\254C\134\000\000\000\000NF\020\004BjT\208\000\000\001\022\000\000\000\000\002\n\000\000\000\000F\b\001\022\028\000\003\200\000&\000\000\000\000\000\017\000\000A\028\004\228\005&\019\168\020\180\020\004C\134C\134EjEj\019\168\020\180\020\180\020\004\000\000\000\000\000\000O\006\020\004\000\000\000\244\000\000T\208qjqj\000\000\tL\000\000\000}\n@\000\000\005\144\000\000\000\000 \140d\250bD\000\000d\250bD\000\000d\250d\250\007\174\000\000d\250\0032\000\000\000\000T:d\250R\172D8\006\158\001\016\000\000\001\146\000\000\005j\000\000\n\138\000\000\000\000LZ\007\174\000\000\000\000D8\007 d\250\000\000MLD8N>\000\000\000\000\000\000\006\238\000\000d\250\000\000\000\252p\200\000\000d\250\005\192d\250\000\000\023|\007H\0032\000\000\000\000\024p\000\000\007\168\000\000V\\\n\176\000\000\007Td\250\011x\000\000\011\138\000\000\004F\000\000\000\000\005\152\000\000\000\000\000\000\026\232\027\220T\208N\198\020\004T\208\000\000\002\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000KnEH\000\000\000\000\000\000\001\236 \224qj\000\000\000\000rv\020\004T\208\000\000\000\000P(T\208Q\148w\144\000\000W\216\000\000T\208\000\000\000\000U\184\000\000\000\000\b\026\000\000\023<\000\000\000\000w\246\000\000k:xp\000\000\128F\003$\000\000\000\000v~\000\000\011\140\000\000\000\000\023\002q\254\000\000\000\000\000\000@\000\019\168\025\248\021\142\000\000\000\000\000\000\000\000\000\028\000\000\000\000W\146\006\244\b\b\002\198d\250\000\216\bx\000\000\000\000\b\222\b\b\005\172\000\000O\006G\176Ej\019\168\020\180\005\162\003\134\000&\000\000\b\030A\028A\028\005\162\003\134\003\134A\028\000\000g \001\224\021P\tL\007<u\194\000\000d\250cDd\250[>c\218d\250\004\174d\250dp\000\000\000\000\021J\001\016[\212\bR\001\016\\\142\000\000g\182\001\224\000\000A\028hL\000\000\0078\011\022]H\000\000\000\000\000\000\000\000\000\000\0240\000\000\000\000\027\134\000\000\t\210\020\180\000\000Y\238Bb\000\000\021\196\000\000\000\000A\028\024\170\000\000\000\000\000\000\000\000X\030\000\000\003\168\000\000I\168\006B\0224\000\000\021\218M\024O\006\020\004H\194N\198\020\004\0164\0164\000\000\000\000\000\000\000\000\001\232\020ZA\168\000\000O\188PrEj\019\168\020\180\006\150A\"\000\000\029\028\000\000Q(Q\222x\214\022dd\250\006B\000\000O\006\020\004\000\000rv\020\004qjT\208@\160\000\000O\006\020\004t\168\000b\000\000T\208@\000d\250\004\168\005\172\t\014\000\000\000\000\000\000F\b\005\b\005\b\000\000\t n^\000\000rv\020\004T\208\023\002\000\000N\198\020\004\0164\021\218\0164\002\220\003\158\000\000\000\000\0164\t\030\000\000\t\138\000\000\0164\003\208\t\222\000\000!\212\000\000\002\228\000\000\000\000\025\170\000\000\017(\022\206\000\000\000\000\000\000\005~\000\000\000\000\026\158\000\000\027\146\000\000\028\134\000\000\018\028\023\194\000\000\000\000\000\000B\154\000\000\000\000\000\000\000\000\029z\000\000\030n\000\000\031b\000\000 V\000\000!J\000\000\">\000\000#2\000\000$&\000\000%\026\000\000&\014\000\000'\002\000\000'\246\000\000(\234\000\000)\222\000\000*\210\000\000+\198\000\000,\186\000\000-\174\000\000.\162\000\000/\150\020\004T\208V\230F\240\005\b\nHh\196T\208\000\000\000\000\000\000d\250\000\000\026\132j\224\000\000\024\236d\250\027x\n\018\000\000\000\000\000\000\000\000h\196\000\000\000\000\002f\011\026\000\000B\146\000\000\000\000\131\230\000\000\006\180\000\000\000\000M \005\b\n\216d\250\006\162\000\000\000\000\0046\0032\000\000d\250\0076\000\000\000\000\011`\000\000\000\000\000\000\025@d\250\007\138\000\000\000\000\027\198\000\000\000\000yP\000\000\028\028y\182\000\000\028\186z0\000\000\029\016\004l\000\000\000\000\000\000\000\000\029\174T\208\030\004n\216n\216\000\000\000\000\000\0000\138\000\000\012<\000\000\000\000\000\000i*\000\000\000\000\000}\bb\000\000\t\002\000\000\000\000X\196H\194\000\000\000\000\012\128\000\000\000\000\000\000\006\132\000\000\000\000\000\000\0164\004\196\tV\000\000\t\246\000\000\005\184\000\0001~\000\000\012\134\000\000\006\172\000\0002r\000\000\012`\007\160\000\0003fd\246\000\000\"\200\000\000\n\234\b\148\000\0004Z\000\000\012\152\t\136\000\0005N\000\000i\172\n|\000\0006B\t\198\nJ\000\000\011<\011p\000\00076\000\000\r0\012d\000\0008*\000\000\t`\rX\000\0009\030\014L\000\000:\018\015@\019\016\000\000\000\000\000\000\011\222\000\000\000\000\rN\000\000\000\000\012\180\000\000\bV\000\000\000\000\000\000\012>\000\000\012f\000\000\000\000G\216\005\b\rZn^D8\002\234\000\000\000\000n^\000\000\000\000\000\000n^\000\000\r\168\000\000\000\000\000\000\000\000\000\000\000\000;\006T\208\000\000\000\000\014&\000\000;\250\000\000<\238\000\000\030\162\000\000\000\000\n6\000\000\000\000T\208\000\000\000\000zF\011\238\000\000\000\000I\168\000\000\011\208\000\000\000\000St\000\000\r`\000\000\000\000\0022\011v\000\000\000\000\021\218\025.\tL\000\000\031\152\000\000\031\172\021\184\022\234\000\000\000\000\012\210\000\000\000\000\001\230\021FU0\000\000\024\182\000\000\b\226\000\000\000\000\rt\000\000\000\000]\236\005\188\0022\000\000\000\000\011\186\000\000\000\000\014$\000\000\000\000\000\000\019\168\020\180\004\174\000\000\000\000\021l\003\200\000&\004\\\020\180u\nA\028\020\144\020\180u\136\r\226\000\000\000\000\004\\\000\000E$\020\004\000\142\000\000\007\128\014T\000\000\014\158\000\000\000\000\003\186D8\006\168\000\000\014\148\014*M \n^d\250\0190\005\216\rx\002\252\000\000\029\012\015F\000\000\006\168\000\000\000\000\015hD8^\132\000\000e\142D8\015<D8jD_\002\b\018\015\006\000\000\000\000\020\004}:\000\000T\208n\216\000\000\000\000\015x\000\000\000\000\000\000=\226\015\172qj>\214_\174\000\000\000\000Cj\000\000\029\232\000\000C\182\000\000\025$\000\000A\028\030\016\000\000}\156\000\000\019\168\020\180}\156\000\000\025\162\020\184\000V\0032\127PA\028z\212n\216\000\000\003\200\002\212\000&\004\\n\216\129~\003\200\000&\004\\n\216\129~\000\000\000\000\004\\n\216\000\000B\154C\134T\208F4\000\000\000\000B\154C\134Ej\019\168\020\180}\156\000\000\025\128\005\162\003$\014\232d\250\t\030\015\184\127\200\000\000n\216\000\000E$\020\004\000\142s\226\007:\011\b\015\176{.\t\248\015\014\020\004n\216\000\000\020\004n\216\000\000j\224\127B\024\172\b\138\000V\001\016o\162\000\000\000V\001\016o\162\000\000\025\162\003\200\007\152\022z\001T\000\000o\162\000\000\000&\015\016A\028}z\130\192\003\200\000&\015\018A\028}z\130\192\000\000\000\000\005P\000\000h\196\000\000A\028\128\020h\196\000\000\005P\000\000N\200\020\004A\028}z\000\000E$\020\004\000\142oV\020\184\020\184\019\174\b>\000\000\012\172\021P\011V\000\000\015\168\015Z\024`\020\004Fld\250\011T\000\000VP\003v\006p\012\186\000\000\r\244\000\000\015\218\015dd\250D|\000\000\020\004\t\132\011\216\000\000\r\246\000\000\015\222\015jM \011\232d\250StD|\000\000]\228\019\206\024`\000\000\016\002\tF\000V\000\000\r2\024`d\250\012>\014\n\0128\014\016\000\000\000\000d\250\b\194\003\254\000\000\000\000kT\000\000\000\000\014&\024`k\210D|\000\000\020\004d\250\012\214d\250S\252D|\000\000\011x\000\000\000\000D|\000\000\000\000VP\000\000n\216\129\130\019\174\b>\012\172\015\242\015\164\024`n\216\129\130\000\000\000\000\019\174\b>\012\172\016\000\015\142N\018f\012D8\016\022N\018d\250\003\254\016(N\018D8\016*N\018\r\002\0144lPl\206\000\000~\028\000\000\000\000n\216\130\206\019\174\b>\012\172\016 \015\172N\018n\216\130\206\000\000\000\000\000\000\127B\000\000\000\000\000\000\000\000\000\000\000\000h\196\000\000\129\252\020\004\021P\0160t>\000\000|\194\129\252\000\000\000\000\131N\020\004\021P\0166\015\198Y\002m\128\006\168\016r\000\000\000\000mFoV\020\004\000\000{\166\000\142\000\000\000\000o\162\131N\000\000\000\000\000\000v\006EZO\200\006\168\016t\000\000\000\000\000\000oV\020\004\000\000\006\168\016\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003v\020\184\019\174\b>\012\172\016lo\198B\178\020\004BjG\130\026\158\002\252\006\168\016r\003\198\000\000\000\000\016$\000\000\000\000F\224\000\000\n$\014H\000\000\014\146\000\000\016z\016\004d\250Wn\016~\004<\000\000\000\000\0166\000\000\000\000\029b\bf\r\162\000\000\016\150ph~J\005\b\0168d\250\012\238\000\000\000\000\016N\000\000\000\000\000\000F\224\000\000\nx\014\132\000\000\014\230\000\000\016\190\016HM \000\000\016\206q\n\132*\005\b\016ld\250\r<\000\000\000\000\016~\000\000\000\000\000\000\020\004\000\000F\224\000\000\020&\019\206B\178B\178r\240B\154\020\004}:T\208\007V\000\000\n:\000V\000\000\014\132B\178d\250\r>\007\174\000\000\020\004U\184o\198B\178\011\226B\178\000\000DfEH\000\000`B\000\000\000\000`\218\000\000\000\000ar\000\000\014\160B\178b\n}:T\208\007V\000\000\000\"\000\000\000\000N\018\014X\000\000\000\000L\028\016\214\000\000F\224\000\000B\178L\028F\224\000\000\020\004d\250F\224\000\000\014\148\000\000\000\000F\224\000\000\000\000G\130\000\000~vN\018\016\136B\178~\246o\198\000\000n\216\130t\019\174\b>\012\172\016\230o\198n\216\130t\000\000\000\000\000\000\131\\O\006\000\000\000\000\000\000\000\000\000\000\000\000\128\140n\216\000\000\129\252\000\000\000\000\000\000\000\000h\196\131\\\000\000\017\030\000\000\000\000\128\140\017&\000\000h\196\131\\\000\000\000\000\014\244\000\000\000\000f\138\026@\000\000\000\000@\160\000\000d\250\012H\000\000G\130\015H\000\000\000\000\000\000\014\172\000\000\000\000\000\000Ej\019\168\020\180\004\174\000\000Fz\000\000\030\220\000\000\001\180\000\000\000\000\0170\000\000\017Zv~\000\000?\202\017B\000\000\000\000\0178\0268\022h\000\142sj\007:\020\004\000\000n\216\000\000\000\000\000\000\000\000\000\000\000\000\000\000s|\007:\020\004\000\000\014\254t>\000\000|\194\000\000\017:\0268\022hn\216\000\000\017J\000\000\006\162\015D\020\004K\150\000\000\000\000\028F\132\\\000\000\000\000\016\226\000\000\0176d\250\000\000\r\144\t\150\007\174\000\000\000\000d\250\t\b\n\210\000\000d\250\n\240\006\168\017^\000\000\000\000{\170\000\000\000\000Y\002\000\000o\162\000\000\017\\\0268\023\\h\196\000\000\000\000\000\000\000\000\015(t>Y\002\000\000o\162\000\000\017^\0268\023\\h\196\000\000\015p\000\000\000\000\031\004\000\000n\216\000\000\017z\000\000\000\000\016\246\000\000\017\000\000\000\017\020\000\000\000\000K \017\022\000\000\000\000d\250\000\000\014\156\000\000\000\000\017\024\000\000\000\000T\208\031\150\000\000\000\000H\194\0032|h\000\000\000\000\000\000\000\000\000\000rh\023l\000\000\000\000\017\172\000\000JV\000\000\015\128\017\184\000\000\017\196\000\000I\168I\168\132>\132>\000\000\000\000nz\132>\000\000\000\000\000\000nz\132>\0178\000\000\017>\000\000"), (16, "\b\193\b\193\000\006\002.\006\005\b\193\002\154\002\158\b\193\002\202\002\214\b\193\003r\b\193\006n\002\218\b\193\023\138\b\193\b\193\b\193\0022\b\193\b\193\006\005\003f\003j\002\222\b\193\003\030\003\"\t\190\b\193\011\238\b\193\003\234\003&\023\142\002\226\006\202\b\193\b\193\003\178\003\182\b\193\003\186\003\014\003\198\003\206\006\170\004-\b\193\b\193\002\146\001v\b\182\003\026\b\193\b\193\b\193\007\234\007\238\007\250\b\014\001*\005R\b\193\b\193\b\193\b\193\b\193\b\193\b\193\b\193\b\193\b\130\000\238\b\193\015N\b\193\b\193\002b\b\142\b\166\b\250\005^\005b\b\193\b\193\b\193\004-\b\193\b\193\b\193\b\193\b\186\b\214\r\186\b\193\003v\b\193\b\193\000\238\b\193\b\193\b\193\b\193\b\193\b\193\005f\b\002\b\193\b\193\b\193\b\026\004.\t\014\015R\b\193\b\193\b\193\b\193\012e\012e\023\146\006r\006\r\012e\003}\012e\012e\015^\012e\012e\012e\012e\004R\012e\012e\0069\012e\012e\012e\001\206\012e\012e\006\r\012e\004-\012e\012e\012e\012e\012e\012e\012e\012e\015f\001j\0069\012e\004\190\012e\012e\012e\012e\012e\000\238\012e\012e\017\198\012e\003\202\012e\012e\012e\001\134\001\206\012e\012e\012e\012e\012e\012e\012e\000\238\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\003}\012e\012e\001f\012e\012e\003U\003>\001r\004-\012e\012e\012e\012e\012e\001\130\012e\012e\012e\012e\012e\0252\012e\012e\004Z\012e\012e\003B\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\0256\004-\012e\012e\012e\012e\001\153\001\153\001\153\004N\006\246\001\153\001\182\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\186\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\0072\b\157\001\153\001\146\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\198\001\153\001\153\001\153\004^\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\006E\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\n\154\001\153\001\153\n\166\003J\006E\007\242\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\014\150\b2\001\153\005\146\001\153\001\153\003N\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\b\157\001\153\001\153\001\153\001\153\001\153\t\245\t\245\003f\003j\tb\t\245\003J\t\245\t\245\003y\t\245\t\245\t\245\t\245\001\206\t\245\t\245\016\170\t\245\t\245\t\245\001b\t\245\t\245\tf\t\245\003N\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\001z\006\026\001\138\t\245\004-\t\245\t\245\t\245\t\245\t\245\002F\t\245\t\245\r\138\t\245\001\214\t\245\t\245\t\245\002z\004-\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004-\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\000\238\t\245\t\245\003y\t\245\t\245\004-\001\002\001\190\004v\t\245\t\245\t\245\t\245\t\245\001\218\t\245\t\245\t\245\t\245\t&\006\134\tV\t\245\007\137\t\245\t\245\001\230\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004-\t\245\t\245\t\245\t\245\t\245\003\153\003\153\004-\004-\006\230\003\153\002J\003\153\003\153\006\198\003\153\003\153\003\153\003\153\000\238\003\153\003\153\004-\003\153\003\153\003\153\t*\003\153\003\153\015n\003\153\007\174\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\r6\001\234\rB\003\153\000\238\003\153\003\153\003\153\003\153\003\153\bU\003\153\003\153\003!\003\153\001\206\003\153\003\153\003\153\007\230\000\238\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003!\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\011&\t\030\tN\011\150\003\153\003\153\005\"\000\238\002\246\021\194\003\153\003\153\003\153\003\153\003\153\002V\003\153\003\153\003\153\003\153\t&\015\206\tV\003\153\n\154\003\153\003\153\n\166\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\006\198\003\153\003\153\003\153\003\153\003\153\003\141\003\141\001\002\001\190\bU\003\141\003\237\003\141\003\141\025\026\003\141\003\141\003\141\003\141\b\137\003\141\003\141\005&\003\141\003\141\003\141\022\n\003\141\003\141\003~\003\141\011.\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\007\174\n\154\015\022\003\141\n\166\003\141\003\141\003\141\003\141\003\141\000\238\003\141\003\141\000\238\003\141\004\178\003\141\003\141\003\141\005\161\015\030\003\141\003\141\003\141\003\141\003\141\003\141\003\141\014\254\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\237\t\030\tN\007&\003\141\003\141\b\230\001f\003U\003\130\003\141\003\141\003\141\003\141\003\141\004b\003\141\003\141\003\141\003\141\t&\025\030\tV\003\141\001\206\003\141\003\141\003\246\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\006\198\003\141\003\141\003\141\003\141\003\141\tq\tq\b\153\003\250\006\021\tq\005.\tq\tq\005\161\tq\tq\tq\tq\006\181\tq\tq\002\182\tq\tq\tq\014\202\tq\tq\006\021\tq\004-\tq\tq\tq\tq\tq\tq\tq\tq\004-\004-\018\n\tq\004-\tq\tq\tq\tq\tq\t\138\tq\tq\000\238\tq\012N\tq\tq\tq\001\150\018\022\tq\tq\tq\tq\tq\tq\tq\000\238\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\000\238\tq\tq\001f\tq\tq\b\153\003U\006\166\004-\tq\tq\tq\tq\tq\nn\tq\tq\tq\tq\tq\018\162\tq\tq\004.\tq\tq\012&\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\007\242\004-\tq\tq\tq\tq\ti\ti\004\206\012*\n\254\ti\000\238\ti\ti\018\170\ti\ti\ti\ti\004-\ti\ti\005\137\ti\ti\ti\003q\ti\ti\011\002\ti\014\210\ti\ti\ti\ti\ti\ti\ti\ti\007\174\b~\015v\ti\004N\ti\ti\ti\ti\ti\005\129\ti\ti\000\238\ti\012f\ti\ti\ti\000\238\004\174\ti\ti\ti\ti\ti\ti\ti\000\238\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\004-\ti\ti\002\158\ti\ti\002\214\006~\006\150\011\026\ti\ti\ti\ti\ti\004f\ti\ti\ti\ti\ti\bV\ti\ti\004\138\ti\ti\004\222\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\004N\017V\ti\ti\ti\ti\ty\ty\003f\017\190\002n\ty\000\238\ty\ty\017Z\ty\ty\ty\ty\002\158\ty\ty\017\210\ty\ty\ty\002\194\ty\ty\004\178\ty\b\137\ty\ty\ty\ty\ty\ty\ty\ty\005b\0116\004E\ty\007\002\ty\ty\ty\ty\ty\007n\ty\ty\000\238\ty\012z\ty\ty\ty\002\238\007\n\ty\ty\ty\ty\ty\ty\ty\000\238\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\005\n\ty\ty\011Z\ty\ty\005\238\004E\018b\b\137\ty\ty\ty\ty\ty\015V\ty\ty\ty\ty\ty\002\250\ty\ty\006\130\ty\ty\rR\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\000\238\b\137\ty\ty\ty\ty\tY\tY\002\209\004-\012\153\tY\006\146\tY\tY\004-\tY\tY\tY\tY\002\254\tY\tY\012\153\tY\tY\tY\011\242\tY\tY\004-\tY\000\n\tY\tY\tY\tY\tY\tY\tY\tY\012\014\000\238\012\030\tY\014\174\tY\tY\tY\tY\tY\bY\tY\tY\006\210\tY\012\154\tY\tY\tY\002\209\011\250\tY\tY\tY\tY\tY\tY\tY\rV\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\011\254\tY\tY\bm\tY\tY\b\210\000\238\006\158\016\022\tY\tY\tY\tY\tY\b\242\tY\tY\tY\tY\tY\004-\tY\tY\002\158\tY\tY\012&\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\t:\000\238\tY\tY\tY\tY\ta\ta\018\206\r\002\bY\ta\000\238\ta\ta\014\178\ta\ta\ta\ta\001\206\ta\ta\003\226\ta\ta\ta\012>\ta\ta\018\214\ta\000\238\ta\ta\ta\ta\ta\ta\ta\ta\012V\017.\012n\ta\bm\ta\ta\ta\ta\ta\007\181\ta\ta\tB\ta\012\174\ta\ta\ta\002z\012F\ta\ta\ta\ta\ta\ta\ta\002\250\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\012J\ta\ta\007\162\ta\ta\019\022\021\226\006\198\026\"\ta\ta\ta\ta\ta\tR\ta\ta\ta\ta\ta\004-\ta\ta\002\250\ta\ta\017f\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\n\134\021\234\ta\ta\ta\ta\t\153\t\153\022n\005\129\012\206\t\153\003\234\t\153\t\153\011&\t\153\t\153\t\153\t\153\004b\t\153\t\153\003\238\t\153\t\153\t\153\012\210\t\153\t\153\022v\t\153\000\238\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\012\230\n\190\012\250\t\153\r\254\t\153\t\153\t\153\t\153\t\153\007\173\t\153\t\153\005\002\t\153\012\194\t\153\t\153\t\153\004j\tb\t\153\t\153\t\153\t\153\t\153\t\153\t\153\026:\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\012\150\t\153\t\153\bq\t\153\t\153\023\002\015\138\014\006\007r\t\153\t\153\t\153\t\153\t\153\003\018\t\153\t\153\t\153\t\153\t\153\011\250\t\153\t\153\n\226\t\153\t\153\000\238\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\012\218\000\238\t\153\t\153\t\153\t\153\t\137\t\137\001\218\014R\019\150\t\137\018\146\t\137\t\137\018r\t\137\t\137\t\137\t\137\006.\t\137\t\137\b\133\t\137\t\137\t\137\011\018\t\137\t\137\026>\t\137\005\018\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\005\026\0062\014\218\t\137\bq\t\137\t\137\t\137\t\137\t\137\000\238\t\137\t\137\014.\t\137\012\222\t\137\t\137\t\137\n\222\012F\t\137\t\137\t\137\t\137\t\137\t\137\t\137\014\026\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\r2\t\137\t\137\018\210\t\137\t\137\011B\014V\014\030\011&\t\137\t\137\t\137\t\137\t\137\002J\t\137\t\137\t\137\t\137\t\137\019\154\t\137\t\137\007\189\t\137\t\137\011\210\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\014\222\004\178\t\137\t\137\t\137\t\137\t\129\t\129\011\214\019.\004\178\t\129\024\226\t\129\t\129\0236\t\129\t\129\t\129\t\129\012\022\t\129\t\129\012^\t\129\t\129\t\129\012v\t\129\t\129\004N\t\129\011\210\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\018\238\012\026\0142\t\129\012b\t\129\t\129\t\129\t\129\t\129\000\238\t\129\t\129\012\170\t\129\012\242\t\129\t\129\t\129\nn\014\138\t\129\t\129\t\129\t\129\t\129\t\129\t\129\rJ\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\0196\t\129\t\129\014\142\t\129\t\129\rb\018\166\002\233\019B\t\129\t\129\t\129\t\129\t\129\005\145\t\129\t\129\t\129\t\129\t\129\018j\t\129\t\129\rj\t\129\t\129\012\022\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\000\238\012^\t\129\t\129\t\129\t\129\t\145\t\145\012\238\004N\014B\t\145\000\238\t\145\t\145\023\026\t\145\t\145\t\145\t\145\014\186\t\145\t\145\r>\t\145\t\145\t\145\r~\t\145\t\145\019\130\t\145\014F\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\015\154\022J\014\190\t\145\003e\t\145\t\145\t\145\t\145\t\145\000\238\t\145\t\145\026\030\t\145\r\006\t\145\t\145\t\145\020*\019\"\t\145\t\145\t\145\t\145\t\145\t\145\t\145\022*\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\022\170\t\145\t\145\007B\t\145\t\145\r\174\018\174\018\218\007\173\t\145\t\145\t\145\t\145\t\145\019B\t\145\t\145\t\145\t\145\t\145\001\206\t\145\t\145\004b\t\145\t\145\014\230\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\r\218\004b\t\145\t\145\t\145\t\145\t\225\t\225\014\234\005\141\007\185\t\225\023\154\t\225\t\225\026.\t\225\t\225\t\225\t\225\019\n\t\225\t\225\019:\t\225\t\225\t\225\0152\t\225\t\225\015Z\t\225\023\158\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\020.\023\218\021\230\t\225\021\238\t\225\t\225\t\225\t\225\t\225\012\161\t\225\t\225\024\254\t\225\r\018\t\225\t\225\t\225\022r\019f\t\225\t\225\t\225\t\225\t\225\t\225\t\225\015b\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\012\173\t\225\t\225\007B\t\225\t\225\022z\005\133\015~\024\186\t\225\t\225\t\225\t\225\t\225\015\130\t\225\t\225\t\225\t\225\t\225\001\206\t\225\t\225\000\238\t\225\t\225\023\014\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\023n\001\206\t\225\t\225\t\225\t\225\003\137\003\137\007\177\007B\024\238\003\137\023\222\003\137\003\137\027\031\003\137\003\137\003\137\003\137\025\178\003\137\003\137\007B\003\137\003\137\003\137\025\230\003\137\003\137\026\194\003\137\015\170\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\026\150\015\190\025\002\003\137\015\214\003\137\003\137\003\137\003\137\003\137\015\234\003\137\003\137\016\018\003\137\004E\003\137\003\137\003\137\024\190\016&\003\137\003\137\003\137\003\137\003\137\003\137\003\137\017&\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\0172\t\030\tN\003\218\003\137\003\137\005\234\004\193\017\218\017\242\003\137\003\137\003\137\003\137\003\137\002\194\003\137\003\137\003\137\003\137\t&\024\242\tV\003\137\018z\003\137\003\137\018~\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\026\198\003\137\003\137\003\137\003\137\003\137\001\221\001\221\018\182\018\186\018\226\001\221\018\230\002\158\001\221\019\018\002\214\001\221\t6\001\221\019\202\002\218\001\221\019\206\001\221\001\221\001\221\019\242\001\221\001\221\019\246\t>\020\006\002\222\001\221\001\221\001\221\001\221\001\221\tF\001\221\020\022\020\"\020^\002\226\020b\001\221\001\221\001\221\001\221\001\221\020\174\003\014\001\190\020\214\001\221\020\218\001\221\001\221\002\146\020\234\021:\003\026\001\221\001\221\001\221\007\234\007\238\007\250\021Z\0122\005R\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\021\154\t\030\tN\021\190\001\221\001\221\021\206\021\246\021\250\022\006\005^\005b\001\221\001\221\001\221\022\022\001\221\001\221\001\221\001\221\012:\0222\012\138\001\221\022B\001\221\001\221\022V\001\221\001\221\001\221\001\221\001\221\001\221\005f\b\002\001\221\001\221\001\221\b\026\004.\022\130\022\134\001\221\001\221\001\221\001\221\t\201\t\201\022\146\022\162\022\182\t\201\023\170\002\158\t\201\024\002\002\214\t\201\t\201\t\201\024*\002\218\t\201\024\146\t\201\t\201\t\201\024\162\t\201\t\201\025>\t\201\025F\002\222\t\201\t\201\t\201\t\201\t\201\t\201\t\201\025V\025b\025\198\002\226\025\218\t\201\t\201\t\201\t\201\t\201\026\n\003\014\001\190\026\018\t\201\026N\t\201\t\201\002\146\026v\026\174\003\026\t\201\t\201\t\201\007\234\007\238\007\250\026\222\t\201\005R\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\026\234\t\201\t\201\026\242\t\201\t\201\026\251\027\011\027+\027w\005^\005b\t\201\t\201\t\201\027\139\t\201\t\201\t\201\t\201\t\201\027\147\t\201\t\201\027\207\t\201\t\201\027\215\t\201\t\201\t\201\t\201\t\201\t\201\005f\b\002\t\201\t\201\t\201\b\026\004.\000\000\000\000\t\201\t\201\t\201\t\201\t\197\t\197\000\000\000\000\000\000\t\197\000\000\002\158\t\197\000\000\002\214\t\197\t\197\t\197\000\000\002\218\t\197\000\000\t\197\t\197\t\197\000\000\t\197\t\197\000\000\t\197\000\000\002\222\t\197\t\197\t\197\t\197\t\197\t\197\t\197\000\000\000\000\000\000\002\226\000\000\t\197\t\197\t\197\t\197\t\197\000\000\003\014\001\190\000\000\t\197\000\000\t\197\t\197\002\146\000\000\000\000\003\026\t\197\t\197\t\197\007\234\007\238\007\250\000\000\t\197\005R\t\197\t\197\t\197\t\197\t\197\t\197\t\197\t\197\t\197\000\000\t\197\t\197\000\000\t\197\t\197\000\000\000\000\000\000\000\000\005^\005b\t\197\t\197\t\197\000\000\t\197\t\197\t\197\t\197\t\197\000\000\t\197\t\197\000\000\t\197\t\197\000\000\t\197\t\197\t\197\t\197\t\197\t\197\005f\b\002\t\197\t\197\t\197\b\026\004.\000\000\000\000\t\197\t\197\t\197\t\197\002)\002)\000\000\000\000\000\000\002)\000\000\002\158\002)\000\000\002\214\002)\t6\002)\000\000\002\218\002)\000\000\002)\002)\002)\000\000\002)\002)\000\000\t>\000\000\002\222\002)\002)\002)\002)\002)\tF\002)\007\161\000\000\000\000\002\226\007\161\002)\002)\002)\002)\002)\000\000\003\014\001\190\000\000\002)\000\000\002)\002)\002\146\000\000\000\000\003\026\002)\002)\002)\007\234\007\238\007\250\000\000\0122\005R\002)\002)\002)\002)\002)\002)\002)\002)\002)\007\161\004\149\002)\000\000\002)\002)\000\000\000\000\004-\000\000\005^\005b\002)\002)\002)\004-\002)\002)\002)\002)\006R\007\161\000\000\002)\004\149\002)\002)\004-\002)\002)\002)\002)\002)\002)\005f\b\002\002)\002)\002)\b\026\004.\000\000\000\000\002)\002)\002)\002)\004-\000\000\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004\218\004-\000\238\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\000\000\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004-\002\250\004-\004-\004-\004-\004-\004-\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\000\000\004-\006\242\000\000\004-\004-\004-\000\238\004-\000\000\000\000\004-\004-\004-\004-\004-\004-\004-\004-\004-\b6\001\190\004-\004-\003\170\002\209\002\158\004-\002\209\018V\014\"\004-\004-\003\138\0146\014J\014Z\000\000\000\000\004-\004-\004-\007^\000\000\004-\004-\004-\004-\000\000\000\129\004-\000\129\000\n\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\238\000\129\022\214\000\129\000\129\003\166\000\129\000\129\002\209\000\000\000\129\000\129\002\146\000\129\000\129\000\000\000\129\000\000\000\129\000\129\002\209\002\209\000\129\000\129\000\000\000\129\000\129\000\129\000\000\000\129\015&\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\002\250\006\190\000\129\000\129\012Q\012=\000\129\000\129\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\002\209\002\209\000\000\000\000\012Q\000\129\000\000\000\129\000\000\000\129\002\026\006\133\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\b6\014\154\002\"\000\129\000\n\002&\012=\000\000\000\222\006Z\014\"\b\177\000\129\006\133\0146\014J\014Z\007\186\000\129\000\129\000\129\000\129\000\000\000\000\000\129\000\129\000\129\000\129\002\025\002\025\014z\000\000\002\209\002\025\b\177\002\158\002\025\007\190\002\214\002\025\000\000\002\025\000\000\002\218\002\025\007:\002\025\002\025\002\025\000\000\002\025\002\025\000\000\007B\000\000\002\222\002\025\002\025\002\025\002\025\002\025\007F\002\025\007\174\000\000\000\000\002\226\000\000\002\025\002\025\002\025\002\025\002\025\006\157\003\014\007\254\000\238\002\025\000\000\002\025\002\025\002\146\000\000\000\000\003\026\002\025\002\025\002\025\007\234\007\238\007\250\000\000\006\157\005R\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\000\000\t\030\tN\015N\002\025\002\025\002b\000\000\000\000\000\000\005^\005b\002\025\002\025\002\025\000\000\002\025\002\025\002\025\002\025\t&\007\194\tV\002\025\000\000\002\025\002\025\000\000\002\025\002\025\002\025\002\025\002\025\002\025\005f\b\002\002\025\002\025\002\025\b\026\004.\000\000\015R\002\025\002\025\002\025\002\025\0025\0025\006\157\000\000\0059\0025\007E\000\000\0025\015^\000\000\0025\007\246\0025\b\181\000\000\0025\000\000\0025\0025\0025\002\158\0025\0025\000\000\000\000\b\165\000\000\0025\0025\0025\0025\0025\000\000\0025\015f\007E\b\181\000\000\000\000\0025\0025\0025\0025\0025\006:\000\000\0059\b\165\0025\007E\0025\0025\007E\bv\005\246\000\000\0025\0025\0025\007E\003\226\025j\017\194\007E\0059\0025\0025\0025\0025\0025\0025\0025\0025\0025\005\250\t\030\tN\015N\0025\0025\002b\000\000\000\000\000\000\000\238\002\250\0025\0025\0025\000\000\0025\0025\0025\0025\t&\000\000\tV\0025\000\000\0025\0025\000\000\0025\0025\0025\0025\0025\0025\bA\000\000\0025\0025\0025\000\238\t\n\000\000\015R\0025\0025\0025\0025\0021\0021\000\000\001\002\001\190\0021\000\000\005\254\0021\015^\005\194\0021\000\000\0021\000\000\b\165\0021\006\n\0021\0021\0021\006\022\0021\0021\bA\000\000\000\000\000\000\0021\0021\0021\0021\0021\000\000\0021\015f\005\254\000\000\000\000\005\194\0021\0021\0021\0021\0021\bA\006\n\000\000\000\000\0021\006\022\0021\0021\000\000\000\000\007\142\006\242\0021\0021\0021\000\000\000\000\021\006\000\000\000\000\000\000\0021\0021\0021\0021\0021\0021\0021\0021\0021\007\146\t\030\tN\bA\0021\0021\000\000\004\218\000\000\000\000\bA\001\206\0021\0021\0021\000\000\0021\0021\0021\0021\t&\007^\tV\0021\000\000\0021\0021\000\000\0021\0021\0021\0021\0021\0021\b=\000\000\0021\0021\0021\000\238\018\130\007\202\006\242\0021\0021\0021\0021\002\029\002\029\002\209\000\000\019\n\002\029\019\014\000\000\002\029\000\000\002\146\002\029\000\000\002\029\007\206\000\000\002\029\019&\002\029\002\029\002\029\000\000\002\029\002\029\b=\000\000\000\n\012\021\002\029\002\029\002\029\002\029\002\029\000\000\002\029\007^\000\000\000\000\000\000\000\000\002\029\002\029\002\029\002\029\002\029\b=\012\021\012\021\000\000\002\029\012\021\002\029\002\029\000\238\002\209\000\000\006\242\002\029\002\029\002\029\000\000\014b\000\000\000\000\000\000\000\000\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\016V\t\030\tN\b=\002\029\002\029\000\000\004\218\000\000\000\000\b=\000\238\002\029\002\029\002\029\000\000\002\029\002\029\002\029\002\029\t&\007^\tV\002\029\000\000\002\029\002\029\000\000\002\029\002\029\002\029\002\029\002\029\002\029\017\142\000\000\002\029\002\029\002\029\000\238\000\000\012\021\000\000\002\029\002\029\002\029\002\029\002-\002-\002\209\002\209\016\130\002-\nM\000\000\002-\n\178\000\n\002-\000\000\002-\t\030\tN\002-\002\209\002-\002-\002-\000\000\002-\002-\000\000\002\209\002\209\000\n\002-\002-\002-\002-\002-\t&\002-\tV\nM\016Z\002\209\004\153\002-\002-\002-\002-\002-\006V\002\158\000\000\000\000\002-\nM\002-\002-\nM\011R\002\209\000\000\002-\002-\002-\nM\000\000\004\153\000\000\nM\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\024\202\006\242\002-\007\173\002-\002-\007\173\000\000\000\000\000\000\000\000\003\226\002-\002-\002-\000\000\002-\002-\002-\002-\024\206\000\000\022*\002-\000\000\002-\002-\000\000\tn\002-\002-\002-\002-\002-\012\029\000\000\002-\002-\002-\000\000\000\000\007^\007\173\002-\002-\002-\002-\b\189\b\189\000\000\000\000\004-\b\189\012\029\012\029\b\189\007\173\012\029\b\189\000\238\b\189\000\000\000\000\t\150\000\000\b\189\t\186\b\189\000\000\b\189\b\189\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\b\189\007\173\000\000\006\153\000\000\004-\b\189\b\189\t\254\n\006\b\189\000\000\000\238\004-\000\000\b\189\000\000\n\014\b\189\000\000\000\000\000\000\006\153\b\189\b\189\000\238\006\153\000\000\007\173\000\000\000\000\000\000\b\189\b\189\t\158\t\222\n\022\n\030\n.\b\189\b\189\000\000\012\029\b\189\000\000\b\189\n6\000\000\000\000\000\000\000\000\0121\000\000\b\189\b\189\n>\000\000\b\189\b\189\b\189\b\189\000\000\000\238\0121\b\189\000\000\b\189\b\189\000\000\n^\b\189\nf\n&\b\189\b\189\012\025\000\000\b\189\nF\b\189\021\178\000\000\000\000\006\242\b\189\b\189\nN\nV\002a\002a\000\000\0121\006\153\002a\012\025\012\025\002a\000\000\012\025\002a\000\000\002a\007\154\000\000\002a\000\000\002a\002a\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\0121\002a\007^\0121\006\173\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\238\000\000\000\000\002a\000\000\002a\002a\000\238\000\000\001*\006\173\002a\002a\002a\006\173\002\209\002\209\002\134\000\000\000\000\002a\002a\t\158\002a\002a\002a\002a\002a\002a\000\000\012\025\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\n\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\001\206\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\025\250\000\000\002a\002a\002a\002\209\011f\000\000\000\000\002a\002a\002a\002a\002I\002I\000\000\000\000\005B\002I\000\238\011n\002I\000\000\011z\002I\000\000\002I\000\000\002z\002I\011\134\002I\002I\002I\011\146\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\000\000\002I\000\000\007=\000\000\000\000\000\000\002I\002I\002I\002I\002I\004v\000\000\000\000\004\197\002I\007=\002I\002I\005\194\000\000\000\000\000\000\002I\002I\002I\007=\000\000\000\000\000\000\007=\000\000\002I\002I\t\158\002I\002I\002I\002I\002I\002I\000\000\006\242\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\007U\007\157\002I\002I\002I\007\157\002I\002I\002I\002I\bb\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\002I\002I\004-\007U\007^\000\000\002I\002I\002I\002I\002U\002U\000\000\000\000\007\157\002U\000\238\007U\002U\000\000\005\194\002U\000\238\002U\004-\000\000\t\150\007U\002U\002U\002U\007U\002U\002U\000\000\007\157\000\000\000\000\002U\002U\002U\t\214\002U\000\000\002U\004-\007q\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\238\000\000\002U\005\254\002U\002U\005\194\000\000\000\000\006\242\002U\002U\002U\007q\000\000\004\218\000\000\007q\000\000\002U\002U\t\158\t\222\002U\002U\002U\002U\002U\016F\006\242\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007i\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\016b\007^\000\000\002U\000\000\002U\002U\022\"\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\238\007i\007^\000\000\002U\002U\002U\002U\002e\002e\000\000\000\000\000\000\002e\000\238\011\170\002e\000\000\007i\002e\000\238\002e\000\000\000\000\002e\007i\002e\002e\002e\007i\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\002e\000\000\0079\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\000\000\000\000\000\002e\0079\002e\002e\005\194\000\000\000\000\006\242\002e\002e\002e\0079\000\000\000\000\000\000\0079\000\000\002e\002e\t\158\002e\002e\002e\002e\002e\002e\025*\006\242\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\000\000\002e\002e\002e\000\000\002e\002e\002e\002e\026\206\007^\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\238\r\242\007^\000\000\002e\002e\002e\002e\002E\002E\000\000\000\000\000\000\002E\000\000\011n\002E\000\000\011z\002E\000\238\002E\000\000\000\000\002E\011\134\002E\002E\002E\011\146\002E\002E\000\000\000\000\000\000\006\189\002E\002E\002E\002E\002E\000\000\002E\000\000\000\000\006\157\000\000\000\000\002E\002E\002E\002E\002E\000\000\006\189\000\000\000\000\002E\006\189\002E\002E\000\000\000\000\000\000\006\157\002E\002E\002E\006\157\000\000\000\000\000\000\000\000\000\000\002E\002E\t\158\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\000\238\000\000\002E\002E\002E\000\000\002E\002E\002E\002E\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\002E\002E\000\000\000\000\006\189\027;\002E\002E\002E\002E\002Q\002Q\000\000\000\000\007\246\002Q\000\000\005\254\002Q\n\154\005\194\002Q\n\166\002Q\000\000\000\000\t\150\006\n\002Q\002Q\002Q\006\022\002Q\002Q\000\000\000\000\000\000\006\149\002Q\002Q\002Q\t\214\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\006\149\000\000\000\000\002Q\006\149\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\t\158\t\222\002Q\002Q\002Q\002Q\002Q\000\000\002\250\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\005\150\006\149\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\003\210\000\000\002M\000\000\006\"\002M\003\222\000\000\002M\004\002\002M\000\000\000\000\t\150\000\000\002M\002M\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\t\214\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\t\158\t\222\002M\002M\002M\002M\002M\000\000\002\158\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\002M\000\000\tZ\003\226\000\000\002M\002M\002M\002M\002u\002u\000\000\000\000\000\000\002u\000\000\011\202\002u\011\218\000\000\002u\000\000\002u\000\000\000\000\t\150\000\000\002u\002u\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\t\254\n\006\002u\000\000\000\000\000\000\000\000\002u\000\000\n\014\002u\000\000\000\000\000\000\000\000\002u\002u\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\t\158\t\222\n\022\n\030\n.\002u\002u\000\000\002\158\002u\000\000\002u\n6\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\n>\000\000\002u\002u\002u\002u\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\n&\002u\002u\000\000\000\000\002u\nF\002u\000\000\012\142\003\226\000\000\002u\002u\nN\nV\002]\002]\000\000\000\000\000\000\002]\000\000\012\162\002]\012\182\000\000\002]\000\000\002]\000\000\000\000\t\150\000\000\002]\002]\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\t\214\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\158\t\222\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002Y\002Y\000\000\000\000\000\000\002Y\000\000\000\000\002Y\000\000\000\000\002Y\000\000\002Y\000\000\000\000\t\150\000\000\002Y\002Y\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\t\214\002Y\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\158\t\222\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002m\002m\000\000\000\000\000\000\002m\000\000\000\000\002m\000\000\000\000\002m\000\000\002m\000\000\000\000\t\150\000\000\002m\002m\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\t\254\n\006\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\158\t\222\n\022\n\030\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\n&\002m\002m\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002A\002A\000\000\000\000\000\000\002A\000\000\000\000\002A\000\000\000\000\002A\000\000\002A\000\000\000\000\t\150\000\000\002A\002A\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\t\214\002A\000\000\002A\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002A\000\000\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\t\158\t\222\002A\002A\002A\002A\002A\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\002A\002A\002A\002A\002A\002A\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002=\002=\000\000\000\000\000\000\002=\000\000\000\000\002=\000\000\000\000\002=\000\000\002=\000\000\000\000\t\150\000\000\002=\002=\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002=\000\000\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\t\254\n\006\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\002=\002=\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\t\158\t\222\n\022\n\030\002=\002=\002=\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\000\000\002=\002=\002=\002=\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\002=\002=\002=\n&\002=\002=\000\000\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002\153\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\000\000\002\153\000\000\002\153\000\000\000\000\t\150\000\000\002\153\002\153\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002\153\000\000\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\254\n\006\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\158\t\222\n\022\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\002\153\002\153\002\153\n&\002\153\002\153\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\0029\0029\000\000\000\000\000\000\0029\000\000\000\000\0029\000\000\000\000\0029\000\000\0029\000\000\000\000\t\150\000\000\0029\0029\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\0029\000\000\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\t\254\n\006\0029\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\0029\0029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\t\158\t\222\n\022\n\030\0029\0029\0029\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\0029\0029\0029\n&\0029\0029\000\000\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\0029\0029\0029\0029\002q\002q\000\000\000\000\000\000\002q\000\000\000\000\002q\000\000\000\000\002q\000\000\002q\000\000\000\000\t\150\000\000\002q\002q\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002q\000\000\002q\000\000\000\000\000\000\000\000\000\000\002q\002q\t\254\n\006\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\t\158\t\222\n\022\n\030\002q\002q\002q\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\002q\002q\002q\002q\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\002q\002q\002q\n&\002q\002q\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\002q\002i\002i\000\000\000\000\000\000\002i\000\000\000\000\002i\000\000\000\000\002i\000\000\002i\000\000\000\000\t\150\000\000\002i\002i\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\t\254\n\006\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\t\158\t\222\n\022\n\030\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\002i\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\002i\002i\002i\n&\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002y\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\t\150\000\000\002y\002y\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\t\254\n\006\002y\000\000\000\000\000\000\000\000\002y\000\000\n\014\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\t\158\t\222\n\022\n\030\n.\002y\002y\000\000\000\000\002y\000\000\002y\n6\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n>\000\000\002y\002y\002y\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\n&\002y\002y\000\000\000\000\002y\nF\002y\000\000\000\000\000\000\000\000\002y\002y\nN\nV\002}\002}\000\000\000\000\000\000\002}\000\000\000\000\002}\000\000\000\000\002}\000\000\002}\000\000\000\000\t\150\000\000\002}\002}\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\t\254\n\006\002}\000\000\000\000\000\000\000\000\002}\000\000\n\014\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\t\158\t\222\n\022\n\030\n.\002}\002}\000\000\000\000\002}\000\000\002}\n6\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\n>\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n&\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\nN\nV\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\150\000\000\002\129\002\129\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\254\n\006\002\129\000\000\000\000\000\000\000\000\002\129\000\000\n\014\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\158\t\222\n\022\n\030\n.\002\129\002\129\000\000\000\000\002\129\000\000\002\129\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n>\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\n&\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\nN\nV\by\by\000\000\000\000\000\000\by\000\000\000\000\by\000\000\000\000\by\000\000\by\000\000\000\000\t\150\000\000\by\by\by\000\000\by\by\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\by\000\000\000\000\000\000\000\000\000\000\by\by\t\254\n\006\by\000\000\000\000\000\000\000\000\by\000\000\n\014\by\000\000\000\000\000\000\000\000\by\by\000\238\000\000\000\000\000\000\000\000\000\000\000\000\by\by\t\158\t\222\n\022\n\030\n.\by\by\000\000\000\000\by\000\000\by\n6\000\000\000\000\000\000\000\000\000\000\000\000\by\by\n>\000\000\by\by\by\by\000\000\000\000\000\000\by\000\000\by\by\000\000\by\by\by\n&\by\by\000\000\000\000\by\nF\by\000\000\000\000\000\000\000\000\by\by\nN\nV\002\133\002\133\000\000\000\000\000\000\002\133\000\000\000\000\002\133\000\000\000\000\002\133\000\000\002\133\000\000\000\000\t\150\000\000\002\133\002\133\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\254\n\006\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n\014\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\158\t\222\n\022\n\030\n.\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n>\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\n^\002\133\nf\n&\002\133\002\133\000\000\000\000\002\133\nF\002\133\000\000\000\000\000\000\000\000\002\133\002\133\nN\nV\bu\bu\000\000\000\000\000\000\bu\000\000\000\000\bu\000\000\000\000\bu\000\000\bu\000\000\000\000\t\150\000\000\bu\bu\bu\000\000\bu\bu\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\bu\000\000\000\000\000\000\000\000\000\000\bu\bu\t\254\n\006\bu\000\000\000\000\000\000\000\000\bu\000\000\n\014\bu\000\000\000\000\000\000\000\000\bu\bu\000\238\000\000\000\000\000\000\000\000\000\000\000\000\bu\bu\t\158\t\222\n\022\n\030\n.\bu\bu\000\000\000\000\bu\000\000\bu\n6\000\000\000\000\000\000\000\000\000\000\000\000\bu\bu\n>\000\000\bu\bu\bu\bu\000\000\000\000\000\000\bu\000\000\bu\bu\000\000\bu\bu\bu\n&\bu\bu\000\000\000\000\bu\nF\bu\000\000\000\000\000\000\000\000\bu\bu\nN\nV\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\150\000\000\002\181\002\181\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\254\n\006\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n\014\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\158\t\222\n\022\n\030\n.\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n>\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\n^\002\181\nf\n&\002\181\002\181\000\000\000\000\002\181\nF\002\181\000\000\000\000\000\000\000\000\002\181\002\181\nN\nV\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\150\000\000\002\177\002\177\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\254\n\006\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n\014\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\158\t\222\n\022\n\030\n.\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n>\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\n^\002\177\nf\n&\002\177\002\177\000\000\000\000\002\177\nF\002\177\000\000\000\000\000\000\000\000\002\177\002\177\nN\nV\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\150\000\000\002\185\002\185\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\254\n\006\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n\014\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\158\t\222\n\022\n\030\n.\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n>\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\n^\002\185\nf\n&\002\185\002\185\000\000\000\000\002\185\nF\002\185\000\000\000\000\000\000\000\000\002\185\002\185\nN\nV\002\165\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\t\150\000\000\002\165\002\165\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\254\n\006\002\165\000\000\000\000\000\000\000\000\002\165\000\000\n\014\002\165\000\000\000\000\000\000\000\000\002\165\002\165\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\158\t\222\n\022\n\030\n.\002\165\002\165\000\000\000\000\002\165\000\000\002\165\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\n>\000\000\002\165\002\165\002\165\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\n^\002\165\nf\n&\002\165\002\165\000\000\000\000\002\165\nF\002\165\000\000\000\000\000\000\000\000\002\165\002\165\nN\nV\002\169\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\150\000\000\002\169\002\169\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\254\n\006\002\169\000\000\000\000\000\000\000\000\002\169\000\000\n\014\002\169\000\000\000\000\000\000\000\000\002\169\002\169\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\158\t\222\n\022\n\030\n.\002\169\002\169\000\000\000\000\002\169\000\000\002\169\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n>\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\n^\002\169\nf\n&\002\169\002\169\000\000\000\000\002\169\nF\002\169\000\000\000\000\000\000\000\000\002\169\002\169\nN\nV\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\150\000\000\002\173\002\173\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\254\n\006\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n\014\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\158\t\222\n\022\n\030\n.\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n>\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\n^\002\173\nf\n&\002\173\002\173\000\000\000\000\002\173\nF\002\173\000\000\000\000\000\000\000\000\002\173\002\173\nN\nV\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\150\000\000\002\193\002\193\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\254\n\006\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n\014\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\158\t\222\n\022\n\030\n.\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n>\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\n^\002\193\nf\n&\002\193\002\193\000\000\000\000\002\193\nF\002\193\000\000\000\000\000\000\000\000\002\193\002\193\nN\nV\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\150\000\000\002\189\002\189\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\254\n\006\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n\014\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\158\t\222\n\022\n\030\n.\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n>\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\n^\002\189\nf\n&\002\189\002\189\000\000\000\000\002\189\nF\002\189\000\000\000\000\000\000\000\000\002\189\002\189\nN\nV\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\150\000\000\002\197\002\197\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\254\n\006\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n\014\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\158\t\222\n\022\n\030\n.\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n>\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\n^\002\197\nf\n&\002\197\002\197\000\000\000\000\002\197\nF\002\197\000\000\000\000\000\000\000\000\002\197\002\197\nN\nV\002\161\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\t\150\000\000\002\161\002\161\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\254\n\006\002\161\000\000\000\000\000\000\000\000\002\161\000\000\n\014\002\161\000\000\000\000\000\000\000\000\002\161\002\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\158\t\222\n\022\n\030\n.\002\161\002\161\000\000\000\000\002\161\000\000\002\161\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\n>\000\000\002\161\002\161\002\161\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\n^\002\161\nf\n&\002\161\002\161\000\000\000\000\002\161\nF\002\161\000\000\000\000\000\000\000\000\002\161\002\161\nN\nV\001\241\001\241\000\000\000\000\000\000\001\241\000\000\000\000\001\241\000\000\000\000\001\241\000\000\001\241\000\000\000\000\001\241\000\000\001\241\001\241\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\001\241\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\001\241\001\241\001\241\001\241\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\001\241\r\202\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\t\150\000\000\002\r\002\r\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\254\n\006\002\r\000\000\000\000\000\000\000\000\002\r\000\000\n\014\002\r\000\000\000\000\000\000\000\000\002\r\002\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\158\t\222\n\022\n\030\n.\002\r\002\r\000\000\000\000\002\r\000\000\002\r\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\n>\000\000\002\r\002\r\r\226\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\n^\002\r\nf\n&\002\r\002\r\000\000\000\000\002\r\nF\002\r\000\000\000\000\000\000\000\000\002\r\002\r\nN\nV\002\t\002\t\000\000\000\000\000\000\002\t\000\000\000\000\002\t\000\000\000\000\002\t\000\000\002\t\000\000\000\000\t\150\000\000\002\t\002\t\002\t\000\000\002\t\002\t\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\t\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\254\n\006\002\t\000\000\000\000\000\000\000\000\002\t\000\000\n\014\002\t\000\000\000\000\000\000\000\000\002\t\002\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\158\t\222\n\022\n\030\n.\002\t\002\t\000\000\000\000\002\t\000\000\002\t\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\n>\000\000\002\t\002\t\002\t\002\t\000\000\000\000\000\000\002\t\000\000\002\t\002\t\000\000\n^\002\t\nf\n&\002\t\002\t\000\000\000\000\002\t\nF\002\t\000\000\000\000\000\000\000\000\002\t\002\t\nN\nV\002\157\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\000\000\000\000\002\157\000\000\002\157\000\000\000\000\t\150\000\000\002\157\002\157\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\157\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\254\n\006\002\157\000\000\000\000\000\000\000\000\002\157\000\000\n\014\002\157\000\000\000\000\000\000\000\000\002\157\002\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\158\t\222\n\022\n\030\n.\002\157\002\157\000\000\000\000\002\157\000\000\002\157\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\n>\000\000\002\157\002\157\002\157\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\n^\002\157\nf\n&\002\157\002\157\000\000\000\000\002\157\nF\002\157\000\000\000\000\000\000\000\000\002\157\002\157\nN\nV\001\253\001\253\000\000\000\000\000\000\001\253\000\000\000\000\001\253\000\000\000\000\001\253\000\000\001\253\000\000\000\000\001\253\000\000\001\253\001\253\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\001\253\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\001\253\001\253\001\253\001\253\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\001\253\r\202\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\000\000\000\000\000\000\006\177\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\006\177\003\233\000\000\002\001\006\177\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\238\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\b\162\002\001\002\001\r\202\000\000\000\000\003\233\000\000\002\001\002\001\002\001\002\001\001\006\000\000\000\006\000\000\000\000\024\214\002\154\002\158\005\254\002\202\002\214\005\194\b\194\000\000\000\000\002\218\001\n\000\000\006\n\000\000\003\018\000\000\006\022\000\000\000\000\000\000\r\182\003\022\001\018\b>\bB\001\030\001\"\000\000\000\000\000\000\003&\000\000\002\226\000\000\025\n\000\000\bf\bj\000\238\003\186\003\014\003\198\bn\006\170\bZ\001:\000\000\002\146\002\002\000\000\003\026\002\002\000\000\000\000\007\234\007\238\007\250\b\014\002\006\005R\000\000\002\006\001>\001B\001F\001J\001N\000\000\000\000\b\130\001R\000\000\000\000\000\000\001V\000\000\b\142\b\166\b\250\005^\005b\003z\005\254\001Z\003z\005\194\024\218\006\214\001\218\001^\006\214\001\218\006\n\000\000\002\146\000\000\006\022\002\146\000\000\001\154\n\222\000\000\000\000\005f\b\002\000\000\001\158\000\000\014\018\004.\t\014\001\006\001\166\000\006\001\170\001\174\000\000\002\154\002\158\000\000\002\202\002\214\006\218\000\000\000\000\006\218\002\218\001\n\000\000\000\000\000\000\b:\000\000\000\000\000\000\000\000\000\000\000\000\003\022\001\018\b>\bB\001\030\001\"\000\000\000\000\000\000\003&\000\000\002\226\000\000\bF\000\000\bf\bj\000\000\003\186\003\014\003\198\bn\006\170\000\000\001:\000\000\002\146\000\000\000\000\003\026\000\000\000\000\000\000\007\234\007\238\007\250\b\014\000\000\005R\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\b\130\001R\000\000\000\000\000\000\001V\000\000\b\142\b\166\b\250\005^\005b\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\241\003\170\000\000\002\158\000\000\000\241\000\000\000\000\001\154\005\234\003\138\000\000\005f\b\002\000\000\001\158\007\178\014\018\004.\t\014\n\234\001\166\000\000\001\170\001\174\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\n\238\000>\003\166\002\158\000\241\000B\0032\000\000\000\000\002\146\000F\000\000\000\241\000\000\000\000\000\000\000J\000\241\000N\000R\000V\000Z\000^\000b\000f\000\000\000\241\000\241\000j\000n\000\000\000r\021\162\000v\000\000\000\000\000\000\006\190\000\000\000\238\000\000\000\000\022\222\002\238\000\000\022\226\000\000\000z\000\000\002\146\000~\000\130\000\241\000\000\000\000\000\000\023\018\000\134\000\138\000\142\000\000\000\241\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\023\"\000\000\000\000\000\186\005\254\000\190\000\194\005\194\n\242\016>\000\000\000\000\000\000\000\198\006\n\000\202\002\002\000\000\006\022\000\000\000\000\000\206\000\210\004Y\000\214\000\006\002\006\000\000\000\246\002\154\002\158\002\162\002\202\002\214\000\000\000\000\000\000\000\000\002\218\000\000\000\000\003\146\000\000\000\000\000\000\004Y\000\000\016N\016\234\003z\002\222\000\000\003\030\003\"\002\002\006\214\001\218\003\150\000\000\003&\000\000\002\226\002\146\016~\002\006\003\178\003\182\000\000\003\186\003\014\003\198\003\206\006\170\000\000\000\000\016\226\002\146\000\000\000\000\003\026\016\250\000\000\000\000\007\234\007\238\007\250\b\014\003z\005R\000\000\006\218\000\000\000\000\006\214\001\218\000\000\017\002\000\000\b\130\000\000\002\146\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\017\022\017B\000\000\000\000\004Y\004Y\000\000\000\000\001\202\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\218\000\000\017\130\021\134\005f\b\002\024\246\000\141\001\210\b\026\004.\t\014\000\141\000\000\002\158\000\141\000\000\002\214\004E\t6\000\000\000\000\002\218\004E\000\000\000\141\000\000\000\141\000\000\000\141\001\242\002z\t>\000\000\002\222\002~\000\000\002\146\004\006\004\018\tF\000\141\000\000\000\000\004\030\002\226\015r\000\141\000\000\000\000\000\000\000\141\000\000\003\014\001\190\000\000\000\141\000\000\000\000\000\141\002\146\004\"\004E\003\026\000\141\000\141\000\141\007\234\007\238\007\250\004E\0122\005R\000\141\000\141\004E\002\194\000\238\000\000\000\000\000\141\000\000\000\000\000\000\000\141\004E\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\141\000\141\000\000\000\000\000\141\000\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\002\209\004E\000\000\002\209\000\000\000\141\000\141\005f\b\002\000\000\004E\000\165\b\026\004.\000\000\000\141\000\165\000\141\002\158\000\165\000\000\002\214\000\000\t6\000\n\000\000\002\218\015N\001*\000\165\002b\000\165\000\000\000\165\000\000\002\209\t>\000\000\002\222\002\209\000\000\003:\002\209\000\000\tF\000\165\021.\000\000\000\000\002\226\000\000\000\165\002\209\002\209\003F\000\165\000\000\003\014\001\190\000\n\000\165\000\000\000\000\000\165\002\146\000\000\015R\003\026\000\165\000\165\000\165\007\234\007\238\007\250\002\209\0122\005R\000\165\000\165\002\209\015^\002\209\021R\000\000\000\165\000\000\000\000\002\209\000\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\165\000\165\000\000\000\000\000\165\000\165\000\000\000\000\015f\001\006\000\000\002\209\000\000\000\000\000\165\0036\002\158\b\226\021^\002\214\000\165\000\165\005f\b\002\002\218\001\n\000\000\b\026\004.\003\018\000\165\000\000\000\165\000\000\016\242\020\242\001\014\001\018\001\022\003V\001\030\001\"\000\000\000\000\003\154\000\000\000\000\000\000\000\000\003Z\000\000\001.\n\218\007\141\000\000\003R\001\190\0016\000\000\000\249\001:\000\000\002\146\000\000\000\249\003\210\025\"\000\000\000\000\003\214\000\000\003\222\005F\002\002\005R\000\000\000\000\001>\001B\001F\001J\001N\000\000\002\006\000\000\001R\005V\000\000\000\000\001V\000\238\000\000\000\000\000\000\005^\005b\000\000\005\162\001Z\000\000\000\000\000\000\000\000\000\249\001^\018\138\003z\000\000\000\000\000\000\000\000\000\249\006\214\001\218\001\154\n\222\000\249\004E\005f\002\146\000\000\001\158\004E\001\162\004.\001\006\000\249\001\166\000\000\001\170\001\174\0036\002\158\n~\005\254\002\214\000\000\005\194\000\000\000\000\002\218\001\n\000\000\000\000\006\n\003\018\000\000\006\218\006\022\000\000\000\000\000\249\001\014\001\018\001\022\003V\001\030\001\"\000\000\000\000\000\249\004E\000\000\000\000\000\000\003Z\000\000\001.\n\218\004E\000\000\003R\001\190\0016\004E\002\194\001:\000\000\002\146\000\000\000\000\003\210\000\000\004E\004E\003\214\000\000\003\222\005F\000\000\005R\000\000\000\000\001>\001B\001F\001J\001N\004q\000\000\000\000\001R\005V\021\174\000\000\001V\000\000\000\000\000\000\004E\005^\005b\000\000\005\162\001Z\000\000\000\000\000\000\004E\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\001\154\n\222\000\000\000\000\005f\002\209\000\000\001\158\000\000\001\162\004.\001\006\022\030\001\166\000\000\001\170\001\174\0036\002\158\rv\016\226\002\214\000\n\000\000\000\000\016\250\002\218\001\n\000\000\000\000\000\000\003\018\000\000\000\000\022\194\022\210\000\000\002\209\001\014\001\018\001\022\003V\001\030\001\"\002\209\000\000\000\000\000\000\000\000\000\000\002\209\003Z\000\000\001.\n\218\000\000\000\000\003R\001\190\0016\004q\000\000\001:\000\000\002\146\000\000\000\000\003\210\000\000\023\198\000\000\003\214\002\209\003\222\005F\000\000\005R\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005V\000\000\000\000\001V\000\000\000\000\000\000\000\000\005^\005b\000\000\005\162\001Z\000\000\000\000\000\000\000\000\006\178\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\n\222\000\000\000\000\005f\000\000\000\000\001\158\000\000\001\162\004.\000\000\b\145\001\166\000\006\001\170\001\174\000\246\002\154\002\158\002\162\002\202\002\214\000\000\000\000\000\000\000\000\002\218\000\000\000\000\004y\000\000\b\145\000\000\b\145\b\145\000\000\000\000\000\000\002\222\000\000\003\030\003\"\000\000\000\000\000\000\003\150\000\000\003&\000\000\002\226\000\000\016~\000\000\003\178\003\182\000\000\003\186\003\014\003\198\003\206\006\170\000\000\000\000\016\226\002\146\000\000\000\000\003\026\016\250\001\202\001\206\007\234\007\238\007\250\b\014\000\000\005R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\002\000\000\b\130\001\210\027F\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\017\022\017B\000\000\000\000\027k\014\166\000\000\000\000\000\000\000\000\000\000\001\242\002\130\000\000\000\000\000\000\002~\000\000\002\146\004\006\004\018\021\134\005f\b\002\b\145\004\030\000\000\b\026\004.\t\014\000\006\000\000\000\000\000\246\002\154\002\158\002\162\002\202\002\214\000\000\000\000\000\000\004\"\002\218\000\000\026\002\027\154\000\000\000\000\000\000\003\218\000\000\000\000\000\000\000\000\002\222\000\000\003\030\003\"\000\000\000\000\025\238\003\150\000\000\003&\000\000\002\226\000\000\016~\000\000\003\178\003\182\000\000\003\186\003\014\003\198\003\206\006\170\000\000\000\000\016\226\002\146\000\000\000\000\003\026\016\250\000\000\000\000\007\234\007\238\007\250\b\014\000\000\005R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\002\000\000\b\130\000\000\027F\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\017\022\017B\000\000\000\000\004\129\000\246\000\000\000\000\002\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004y\000\000\000\000\021\134\005f\b\002\014&\0121\0121\b\026\004.\t\014\0121\000\000\0121\0121\003\150\000\000\000\000\000\000\000\000\000\000\016~\0121\000\000\0121\0121\0121\000\000\0121\0121\024F\000\000\000\000\016\226\000\000\000\000\000\000\000\000\016\250\000\000\0121\000\000\000\000\000\000\000\000\000\000\0121\0121\000\000\000\000\0121\000\000\000\000\0121\017\002\0121\000\000\000\000\0121\000\000\000\000\000\000\000\000\0121\0121\0121\000\000\000\000\017\022\017B\000\000\000\000\0121\0121\000\000\000\000\000\000\000\000\000\000\0121\000\000\000\000\000\000\0121\000\000\000\000\0121\000\246\000\000\021\134\002\014\000\000\000\000\0121\0121\0121\000\000\0121\0121\000\000\017\134\000\000\000\000\000\000\000\000\000\000\000\000\0121\000\000\0121\0121\000\000\000\000\002v\0121\000\000\017\138\000\000\000\000\0121\000\000\ne\017\178\0121\ne\0121\0121\ne\ne\000\000\000\000\ne\000\000\ne\016\226\000\000\ne\000\000\000\000\016\250\ne\ne\000\000\ne\ne\000\000\ne\001\202\001\206\000\000\000\000\ne\000\000\000\000\ne\018.\000\000\000\000\000\000\000\000\000\000\000\000\ne\000\000\ne\001\210\000\000\ne\ne\017\022\018B\000\000\000\000\004M\ne\000\000\000\000\ne\000\000\000\000\ne\ne\000\000\ne\000\000\ne\ne\001\242\002\130\000\000\018R\000\000\002~\000\000\002\146\004\006\004\018\000\000\ne\000\000\000\000\004\030\000\000\000\000\000\000\000\000\ne\ne\006\141\000\000\ne\000\000\ne\006\141\000\000\000\000\000\000\005~\004\"\000\000\000\000\004\185\000\000\000\000\ne\ne\000\000\ne\ne\000\000\ne\000\000\ne\000\000\ne\000\000\ne\025\238\ne\b}\b}\000\000\000\000\000\000\b}\000\000\001\206\b}\000\000\000\000\000\000\000\000\006\141\012Q\012=\b}\000\000\b}\b}\b}\006\141\b}\b}\000\000\000\000\006\141\006\141\000\238\000\000\000\000\000\000\012Q\000\000\b}\006\141\006\141\000\000\002\026\000\000\b}\b}\000\000\000\000\b}\002\030\000\000\002z\000\000\b}\000\000\002\"\b}\000\000\002&\012=\000\000\b}\b}\b}\000\000\006\141\000\000\000\000\000\000\000\000\b}\b}\000\000\000\000\006\141\000\000\000\000\b}\000\000\000\000\000\000\004v\000\000\000\000\b}\000\000\000\000\000\000\000\000\000\000\023\166\b}\b}\b}\000\000\b}\b}\000\000\000\000\003\129\012e\000\000\000\000\n\170\000\000\b}\000\000\b}\b}\001\202\001\206\011\n\b}\000\000\000\000\000\000\000\000\b}\003\129\000\000\000\000\b}\003\129\b}\b}\012\r\012\r\002\138\001\226\000\000\012\r\000\000\001\206\012\r\000\000\000\000\001\238\000\000\000\000\000\000\000\000\004\150\000\000\012\r\012\r\012\r\000\000\012\r\012\r\001\242\002r\000\000\000\000\000\000\002~\000\000\002\146\004\006\004\018\012\r\000\000\000\000\000\000\004\030\000\000\012\r\012\r\000\000\000\000\012\r\000\000\000\000\002z\000\000\012\r\012e\012e\012\r\000\000\000\000\004\"\000\000\012\r\012\r\012\r\000\000\000\000\000\000\003\129\000\000\000\000\012\r\012\r\000\000\012e\000\000\012e\000\000\012\r\000\000\000\000\000\000\004v\003\129\000\000\012\r\003\129\000\000\000\000\000\000\000\000\000\000\012\r\012\r\012\r\000\000\012\r\012\r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\r\000\000\012\r\012\r\001\202\001\206\000\000\012\r\000\000\000\000\000\000\000\000\012\r\000\000\000\000\000\000\012\r\000\000\012\r\012\r\b\129\b\129\001\210\001\226\002\209\b\129\000\000\001\206\b\129\002\209\000\000\001\238\000\000\000\000\018\130\000\000\b\129\000\000\b\129\b\129\b\129\000\000\b\129\b\129\001\242\019\250\000\000\019\014\000\000\002~\000\000\002\146\004\006\004\018\b\129\000\n\000\000\000\000\020\n\000\000\b\129\b\129\000\000\000\000\b\129\000\000\000\000\002z\002\209\b\129\002\209\000\000\b\129\000\000\000\000\004\"\002\209\b\129\b\129\b\129\000\000\002\209\000\000\002\209\000\000\000\000\b\129\b\129\000\000\000\000\002\209\002\209\000\000\b\129\002\209\002\209\002\209\004v\002\209\000\000\b\129\000\000\000\000\002\209\000\000\000\000\002\209\b\129\b\129\b\129\000\000\b\129\b\129\000\000\000\000\002\209\002\209\000\000\002\209\000\n\000\n\b\129\002\209\b\129\b\129\002\209\002\209\002\209\b\129\002\209\002\209\002\209\002\209\b\129\002\209\002\209\002\209\b\129\000\000\b\129\b\129\002\209\002\209\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\000\n\000\000\002\209\006\174\000\000\002\209\002\209\002\209\000\000\015\006\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\000\000\002\209\000\000\000\000\002\209\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\015B\000\000\000\000\006=\002\209\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000\000\000\000\015N\000\000\000!\002b\000\000\002\209\002\209\006=\000\000\000\000\002\209\002\209\002\209\000\000\000!\000\000\000!\000!\000\000\000\000\000\000\000\000\000\000\000!\000\000\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000!\000!\000!\000\000\000\000\015R\000!\007\025\000\000\000!\007\025\000\000\000\000\000!\000!\000!\000!\000\000\000!\015^\000\000\0212\000\000\000\000\000\000\000\000\007\025\007\025\000!\007\025\007\025\000\000\000\000\000\000\000\000\000!\000!\000!\000!\000!\000\000\000\000\000\000\000\000\0069\015f\000\029\000\000\007\025\000\000\000\029\000\029\000\000\000\029\000\029\021>\000\000\000\000\000\000\000\029\000\000\000\000\000!\000!\0069\000\000\007\025\000!\000!\000!\000\000\000\029\020\242\000\029\000\029\000\000\000\000\000\000\000\000\000\000\000\029\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\007\025\000\029\007\025\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\000\000\029\005\186\000\000\000\000\007\025\007\025\000\000\000\000\000\000\007\025\000\029\007\025\000\000\000\000\000\000\007\025\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\000\006I\000\000\011\213\000\000\000\000\000\000\011\213\011\213\000\000\011\213\011\213\000\000\000\000\000\000\000\000\011\213\000\000\000\000\000\029\000\029\006I\000\000\000\000\000\029\000\029\000\029\000\000\011\213\000\000\011\213\011\213\000\000\000\000\000\000\000\000\000\000\011\213\000\000\011\213\000\000\000\000\000\000\011\213\011\213\000\000\011\213\011\213\011\213\011\213\011\213\000\000\000\000\000\000\011\213\007-\000\000\011\213\007-\000\000\000\000\011\213\011\213\011\213\011\213\000\000\011\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007-\007-\011\213\007-\007-\000\000\000\000\000\000\000\000\011\213\011\213\011\213\011\213\011\213\000\000\000\000\000\000\000\000\006E\000\000\011\209\000\000\007-\000\000\011\209\011\209\000\000\011\209\011\209\000\000\000\000\000\000\000\000\011\209\000\000\000\000\011\213\011\213\006E\000\000\000\238\011\213\011\213\011\213\000\000\011\209\000\000\011\209\011\209\000\000\000\000\000\000\000\000\000\000\011\209\000\000\011\209\000\000\000\000\000\000\011\209\011\209\000\000\011\209\011\209\011\209\011\209\011\209\000\000\000\000\007-\011\209\007-\000\000\011\209\000\000\000\000\000\000\011\209\011\209\011\209\011\209\000\000\011\209\007-\000\000\000\000\005\194\007-\000\000\000\000\000\000\007-\011\209\007-\000\000\000\000\000\000\007-\000\000\011\209\011\209\011\209\011\209\011\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\014\012\017\012\017\000\000\000\000\000\000\012\017\011\209\011\209\012\017\017\134\000\000\011\209\011\209\011\209\012Q\012=\004F\000\000\012\017\012\017\012\017\000\000\012\017\012\017\000\000\017\138\000\000\000\000\000\000\000\000\000\000\017\178\012Q\000\000\012\017\000\000\000\000\000\000\002\026\000\000\012\017\012\017\000\000\016\226\012\017\002\174\000\000\000\000\016\250\012\017\000\000\002\"\012\017\000\000\002&\012=\000\000\012\017\012\017\012\017\000\000\000\000\000\000\000\000\018.\000\000\012\017\012\017\000\000\000\000\000\000\000\000\000\000\012\017\000\000\000\000\000\000\012\017\017\022\018B\012\017\000\000\000\000\004M\000\000\000\000\000\000\012\017\012\017\012\017\000\000\012\017\012\017\000\000\000\000\000\000\000\000\000\000\000\000\018R\007\153\012\017\000\006\012\017\012\017\007\153\002\154\002\158\012\017\002\202\002\214\000\000\000\000\012\017\000\000\002\218\000\000\012\017\000\000\012\017\012\017\000\000\014:\000\000\000\000\000\000\000\000\002\222\000\000\003\030\003\"\000\000\000\000\000\000\000\000\000\000\003&\000\000\002\226\000\000\000\000\000\000\003\178\003\182\007\153\003\186\003\014\003\198\003\206\006\170\000\000\000\000\007\153\002\146\000\000\000\000\003\026\007\153\007\153\000\238\007\234\007\238\007\250\b\014\000\000\005R\007\153\007\153\001\181\000\000\000\000\000\000\000\000\001\181\000\000\b\130\000\000\000\000\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\000\000\000\000\007\153\000\000\000\000\007\153\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\007\153\000\000\000\000\003\t\000\000\000\000\003\t\000\000\005f\b\002\000\000\001\181\000\000\b\026\004.\t\014\003\t\003\t\003\t\001\181\003\t\003\t\000\000\000\000\001\181\001\181\000\238\000\000\000\000\000\000\000\000\000\000\003\t\001\181\001\181\000\000\000\000\000\000\003\t\004>\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\001\181\000\000\000\000\000\000\000\000\003\t\003\t\000\000\000\000\001\181\000\000\000\000\003\t\000\000\nq\000\000\003\t\nq\000\000\003\t\0036\002\158\000\000\000\000\002\214\000\000\003\t\003\t\003\t\002\218\003\t\003\t\000\000\nq\nq\000\000\nq\nq\000\000\000\000\003\t\000\000\003\t\003\t\003:\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\nq\003\t\003F\003\t\003\t\003R\001\190\003\133\012e\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\nq\003\214\000\000\003\222\005F\000\000\005R\000\000\003\133\000\000\000\000\000\000\003\133\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\005\162\nq\000\000\nq\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nq\000\000\000\000\nq\nq\000\000\005f\000\000\nq\000\000\nq\000\000\004.\nm\nq\000\000\nm\000\000\000\000\0036\002\158\012e\012e\002\214\000\000\006z\000\000\000\000\002\218\000\000\000\000\000\000\nm\nm\003\133\nm\nm\000\000\006\154\000\000\012e\000\000\012e\003:\000\000\000\000\b\178\000\000\000\000\003\133\000\000\000\000\003\133\000\000\nm\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\nm\003\214\000\000\003\222\005F\n\138\005R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004i\005V\000\000\000\000\000\000\018\154\001\205\001\205\000\000\005^\005b\001\205\005\162\nm\001\205\nm\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\001\205\001\205\nm\001\205\001\205\nm\nm\000\000\005f\000\000\nm\000\000\nm\000\000\004.\001\205\nm\000\000\000\000\018\198\000\000\001\205\001\205\000\000\000\000\001\205\000\000\016\226\000\000\000\000\001\205\000\000\016\250\001\205\000\000\000\000\000\000\000\000\001\205\001\205\001\205\000\000\019\002\000\000\000\000\000\000\000\000\001\205\001\205\000\000\000\000\000\000\000\000\000\000\001\205\000\000\0036\002\158\001\205\000\000\002\214\001\205\006z\000\000\000\000\002\218\000\000\004i\001\205\001\205\001\205\000\000\001\205\001\205\000\000\006\154\019v\000\000\000\000\000\000\003:\000\000\001\205\b\178\001\205\001\205\000\000\000\000\000\000\001\205\000\000\000\000\000\000\003F\001\205\000\000\nz\001\190\004\218\000\000\001\205\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\nI\003\214\000\000\003\222\000\000\n\138\005R\000\000\000\000\012\129\000\000\000\000\000\000\000\000\012\129\000\000\000\000\000\000\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\000\000\n\146\000\000\000\000\0036\002\158\000\000\000\000\002\214\000\000\006z\000\000\000\000\002\218\000\000\nI\n\154\000\000\nI\011\006\000\000\005f\000\000\006\154\012\129\nI\000\000\004.\003:\nI\000\000\b\178\012\129\007\005\000\000\000\000\007\005\012\129\012\129\000\238\000\000\003F\000\000\000\000\nz\001\190\012\129\012\129\000\000\000\000\000\000\002\146\007\005\007\005\003\210\007\005\007\005\nI\003\214\000\000\003\222\000\000\n\138\005R\000\000\000\000\000\000\000\000\005)\005)\000\000\000\000\012\129\005)\007\005\005V\005)\000\000\000\000\000\000\000\000\012\129\000\000\005^\005b\000\000\005)\n\146\005)\000\000\005)\000\000\007\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nI\005)\000\000\nI\nI\000\000\005f\005)\005)\000\000\nI\000\000\004.\005)\nI\000\000\005)\000\000\000\000\005)\000\000\007\005\000\000\007\005\005)\005)\005)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\005\000\000\000\000\005\194\007\005\005)\005)\000\000\007\005\005)\007\005\000\000\000\000\000\000\007\005\b\141\000\000\000\000\000\000\005)\005)\005)\000\000\005)\005)\000\000\000\000\000\000\000\000\007B\000\000\t\150\000\000\000\000\012\006\b\141\005)\b\141\b\141\005)\005)\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\000\000\000\000\005)\001\202\002^\000\000\000\000\002b\t\254\n\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\014\000\000\000\000\000\000\001\210\001\226\002f\000\000\000\238\000\000\000\000\000\000\000\000\001\238\000\000\000\000\001\006\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\000\000\002j\002r\000\000\n6\000\000\002~\001\n\002\146\004\006\004\018\000\000\000\000\n>\000\000\020\222\000\000\020\226\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\n^\000\000\nf\n&\001&\004\"\001.\0012\b\141\nF\000\000\000\000\0016\000\000\015f\001:\000\000\nN\nV\000\000\000\000\000\000\000\000\000\000\020\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\020\242\000\000\000\000\001V\000\000\005\029\005\029\000\000\000\000\000\000\005\029\000\000\001Z\005\029\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\005\029\000\000\005\029\000\000\005\029\001\154\000\000\000\000\000\000\000\000\000\000\000\000\001\158\000\000\001\162\000\000\005\029\000\000\001\166\000\000\001\170\001\174\005\029\005\029\000\000\000\000\000\000\000\000\007\174\000\000\000\000\005\029\000\000\000\000\005\029\000\000\000\000\000\000\000\000\005\029\005\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\029\005\029\003I\003I\005\029\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\000\000\005\029\005\029\005\029\000\000\005\029\005\029\003I\000\000\003I\000\000\003I\000\000\000\000\000\000\000\000\000\000\000\000\005\029\000\000\000\000\005\029\005\029\003I\000\000\000\000\000\000\000\000\000\000\003I\003I\000\000\000\000\005\029\000\000\004\233\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\000\000\000\000\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\003I\003I\000\000\003I\003I\b\t\b\t\000\000\000\000\004\233\b\t\000\000\000\000\b\t\000\000\000\000\003I\000\000\000\000\000\000\003I\000\000\000\000\b\t\000\000\b\t\000\000\b\t\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\t\000\000\000\000\000\000\000\000\000\000\b\t\b\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\t\000\000\000\000\b\t\000\000\000\000\000\000\000\000\b\t\b\t\b\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\t\000\000\012\193\012\193\b\t\000\000\000\000\012\193\000\000\000\000\012\193\000\000\000\000\000\000\b\t\b\t\b\t\000\000\b\t\b\t\012\193\000\000\012\193\000\000\012\193\000\000\000\000\000\000\b\t\000\000\000\000\b\t\000\000\000\000\000\000\b\t\012\193\000\000\000\000\000\000\000\000\000\000\012\193\012\193\004\218\000\000\b\t\000\000\004N\000\000\000\000\012\193\000\000\000\000\012\193\000\000\000\000\000\000\000\000\012\193\012\193\012\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\193\000\000\000\000\000\000\012\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\193\012\193\012\193\000\000\012\193\012\193\012\197\012\197\000\000\000\000\004^\012\197\000\000\000\000\012\197\000\000\000\000\012\193\000\000\000\000\000\000\012\193\000\000\000\000\012\197\000\000\012\197\000\000\012\197\000\000\000\000\000\000\012\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\012\197\012\197\000\000\000\000\000\000\000\000\004N\000\000\000\000\012\197\000\000\000\000\012\197\000\000\000\000\000\000\000\000\012\197\012\197\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\012\197\012\197\000\000\012\197\012\197\003I\003I\000\000\000\000\004^\003I\000\000\000\000\003I\000\000\000\000\012\197\000\000\000\000\000\000\012\197\000\000\000\000\003I\000\000\003I\000\000\003I\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\000\000\003I\003I\000\000\000\000\000\000\000\000\004\237\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\000\000\000\000\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\003I\007\149\000\000\000\000\000\000\006\161\007\149\000\000\000\000\000\000\003I\003I\003I\000\000\003I\003I\000\000\000\000\000\000\000\000\004\237\t\150\000\000\000\000\006\161\000\000\000\000\003I\006\161\000\000\000\000\003I\000\000\t\206\t\230\t\238\t\214\t\246\000\000\000\000\000\000\000\000\003I\000\000\000\000\007\149\000\000\t\254\n\006\000\000\000\000\000\000\000\000\007\149\000\000\000\000\n\014\000\000\007\149\007\149\000\238\000\000\000\000\000\000\000\238\000\000\000\000\007\149\007\149\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\001\189\000\000\000\000\006\161\n6\001\189\000\000\001\206\001\189\007\149\000\000\000\000\007\149\n>\000\000\000\000\bi\000\000\001\189\000\000\000\000\007\149\001\189\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\000\000\000\000\000\000\001\189\000\000\nF\000\000\012)\000\000\001\189\001\189\000\000\012)\nN\nV\012)\002z\000\000\001\189\000\000\000\000\001\189\000\000\000\000\000\000\012)\001\189\001\189\001\189\012)\000\000\000\000\003-\000\000\000\000\0121\000\000\003-\000\000\001\206\003-\012)\001\189\001\189\000\000\000\000\004v\012)\be\000\000\003-\000\000\000\000\000\000\003-\000\000\001\189\001\189\000\000\012)\001\189\001\189\000\000\000\000\012)\012)\003-\000\000\000\000\000\000\001\189\000\000\003-\001\185\000\000\000\000\000\000\001\189\000\000\002z\012)\003-\001\189\000\000\003-\000\000\000\000\000\000\001\189\003-\003-\003-\000\000\000\000\012)\012)\002Z\000\000\012)\012)\000\000\000\000\000\000\000\000\000\000\003-\003-\000\000\012)\004v\000\000\000\000\026b\000\000\000\000\012)\000\000\000\000\0162\003-\003-\000\000\000\000\003-\003-\000\000\012)\000\000\000\000\000\000\000\000\000\000\000\000\003-\t\150\000\000\000\000\000\000\0166\000\000\003-\000\000\000\000\000\000\000\000\003-\t\206\t\230\t\238\t\214\t\246\003-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\254\n\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\149\000\000\000\000\000\000\000\000\000\149\n6\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\n>\000\000\000\000\000\149\000\000\000\149\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\n^\016:\nf\n&\016J\000\149\000\000\000\000\000\000\nF\000\000\000\149\000\000\000\000\000\000\000\149\000\000\nN\nV\000\000\000\149\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\149\000\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\000\000\000\000\217\000\149\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\149\000\149\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\217\000\000\000\217\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\149\000\000\000\149\000\217\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\217\000\217\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\157\000\217\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\217\000\217\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\217\000\000\000\217\000\157\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\153\000\157\000\000\000\000\000\000\000\153\000\000\000\000\000\153\000\000\000\000\000\157\000\157\000\000\000\000\000\157\000\157\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\153\006}\006}\000\000\000\000\000\000\000\153\000\157\000\000\000\157\000\153\000\000\000\000\000\000\000\000\000\153\000\000\004\022\000\153\006}\006}\000\000\000\000\000\153\000\153\000\238\000\000\000\000\006}\001\129\000\000\000\000\000\153\000\153\001\129\000\000\000\000\001\129\000\000\000\153\000\000\006}\006}\000\153\000\000\000\000\006}\001\129\006}\006}\006}\001\129\000\000\000\153\000\153\006}\000\000\000\153\000\153\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\153\000\000\001\129\000\000\000\000\006}\000\153\000\153\004\233\000\000\000\000\001\129\000\000\000\000\001\129\000\000\000\153\000\000\000\153\001\129\001\129\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001\129\000\000\004\n\000\000\006}\000\000\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\001\129\001\129\000\000\012\189\012\189\000\000\004\233\000\000\012\189\000\000\001\129\012\189\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\000\012\189\001\129\012\189\000\000\012\189\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\000\000\000\000\012\189\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\012\189\000\000\000\000\000\000\000\000\012\189\012\189\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\012\185\012\185\012\189\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\012\189\012\189\012\189\000\000\012\189\012\189\012\185\000\000\012\185\000\000\012\185\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\012\189\012\185\000\000\000\000\000\000\000\000\000\000\012\185\012\185\004\218\000\000\012\189\000\000\000\000\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\000\000\012\185\012\185\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\185\000\000\b\r\b\r\012\185\000\000\000\000\b\r\000\000\000\000\b\r\000\000\000\000\000\000\012\185\012\185\012\185\000\000\012\185\012\185\b\r\000\000\b\r\000\000\b\r\000\000\000\000\000\000\007\030\000\000\000\000\012\185\000\000\000\000\000\000\012\185\b\r\000\000\000\000\000\000\000\000\000\000\b\r\b\r\000\000\000\000\012\185\000\000\000\000\000\000\000\000\b\r\000\000\000\000\b\r\000\000\000\000\000\000\000\000\b\r\b\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\134\000\000\n\158\000\000\000\000\000\000\b\r\000\000\001\202\001\206\b\r\000\000\000\000\000\000\000\000\000\000\t\150\000\000\000\000\012\006\b\r\b\r\b\r\b\141\b\r\b\r\001\210\001\226\t\206\t\230\t\238\t\214\t\246\000\000\b\r\001\238\000\000\b\r\000\000\000\000\000\000\b\r\t\254\n\006\000\000\000\000\000\000\000\000\001\242\002r\000\000\n\014\b\r\002~\000\000\002\146\004\006\004\018\000\000\000\238\000\000\000\000\004\030\000\000\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\001\185\000\000\000\000\004\"\n6\001\185\000\000\001\206\001\185\000\000\000\000\000\000\000\000\n>\000\000\000\000\be\000\000\001\185\000\000\000\000\000\000\001\185\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\000\000\000\000\000\000\001\185\000\000\nF\000\000\000\000\004*\001\185\004.\000\000\000\000\nN\nV\000\000\002z\000\000\001\185\000\000\000\000\001\185\000\000\000\000\000\000\000\000\001\185\001\185\001\185\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001i\000\000\0121\001i\000\000\001\185\001\185\000\000\000\000\004v\000\000\0121\000\000\001i\000\000\001i\000\000\001i\000\000\001\185\001\185\000\000\000\000\001\185\001\185\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\001\185\000\000\001i\0121\000\000\000\000\000\000\001\185\000\000\0121\000\000\000\000\001\185\000\000\001i\000\000\000\000\000\000\001\185\001i\001i\001i\000\000\000\000\000\000\005U\005U\000\000\000\000\000\000\005U\000\000\000\000\005U\000\000\001i\000\000\000\000\000\000\0121\000\000\000\000\000\000\005U\000\000\005U\000\000\005U\000\000\001i\001i\001i\000\000\001i\001i\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\000\000\000\000\005U\005U\000\000\000\000\019\254\001i\007\174\000\000\000\000\005U\000\000\000\000\005U\000\000\000\000\000\000\001i\005U\005U\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\005Q\006\242\005U\000\000\000\000\005Q\000\000\000\000\005Q\000\000\000\000\000\000\005U\005U\005U\000\000\005U\005U\005Q\000\000\005Q\000\000\005Q\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\005U\005Q\000\000\000\000\000\000\000\000\000\000\005Q\007^\000\000\000\000\005U\000\000\000\000\000\000\000\000\005Q\000\000\000\000\005Q\000\000\000\000\000\000\000\000\005Q\005Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005Q\000\000\005m\005m\005Q\000\000\000\000\005m\000\000\000\000\005m\000\000\000\000\000\000\005Q\005Q\005Q\000\000\005Q\005Q\005m\000\000\005m\000\000\005m\000\000\000\000\000\000\000\000\000\000\000\000\005Q\000\000\000\000\000\000\005Q\005m\000\000\000\000\000\000\000\000\000\000\005m\005m\000\000\000\000\005Q\000\000\000\000\000\000\000\000\005m\000\000\000\000\005m\000\000\000\000\000\000\000\000\005m\005m\005m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005m\000\000\005i\006\242\005m\000\000\000\000\005i\000\000\000\000\005i\000\000\000\000\000\000\005m\005m\005m\000\000\005m\005m\005i\000\000\005i\000\000\005i\000\000\000\000\000\000\000\000\000\000\000\000\005m\000\000\000\000\000\000\005m\005i\000\000\000\000\000\000\000\000\000\000\005i\007^\000\000\000\000\007V\000\000\000\000\000\000\000\000\005i\000\000\000\000\005i\000\000\000\000\000\000\000\000\005i\005i\000\238\004E\000\000\000\000\000\000\000\000\004E\0036\002\158\004E\000\000\002\214\000\000\006z\005i\000\000\002\218\000\000\005i\004E\000\000\000\000\000\000\004E\000\000\000\000\006\154\000\000\005i\005i\005i\003:\005i\005i\b\178\004E\000\000\000\000\000\000\000\000\000\000\004E\000\000\000\000\003F\005i\000\000\nz\001\190\005i\004E\000\000\011\226\004E\002\146\000\000\000\000\003\210\004E\002\194\005i\003\214\000\000\003\222\000\000\n\138\005R\000\000\t\150\000\000\000\000\000\000\000\000\000\000\004E\011\230\000\000\000\000\005V\000\000\t\206\t\230\t\238\t\214\t\246\000\000\005^\005b\004E\004E\n\146\000\000\004E\004E\t\254\n\006\000\000\000\000\007B\000\000\000\000\000\000\000\000\n\014\000\000\n\154\000\000\000\000\n\166\004E\005f\000\238\000\000\000\000\021\006\000\000\004.\011\226\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\t\150\000\000\000\000\000\000\000\000\000\000\000\000\012\190\n>\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\t\254\n\006\000\000\000\000\000\000\nF\000\000\000\000\000\000\n\014\000\000\000\000\000\000\nN\nV\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\003)\000\000\000\000\000\000\n6\003)\000\000\001\206\003)\000\000\000\000\000\000\000\000\n>\000\000\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\000\000\000\000\000\000\003)\000\000\nF\000\000\000\000\000\000\003)\000\000\000\000\000\000\nN\nV\000\000\002z\000\000\003)\000\000\000\000\003)\000\000\000\000\000\000\000\000\003)\003)\003)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\003)\000\000\000\000\004v\n\170\000\000\000\000\000\000\000\000\000\246\001\202\001\206\002\014\003)\003)\000\000\000\000\003)\003)\000\000\000\000\000\000\017\134\000\000\000\000\000\000\004M\003)\001\210\001\226\000\000\000\000\000\000\000\000\003)\000\000\000\000\001\238\017\138\003)\000\000\000\000\000\000\000\000\017\178\003)\000\000\000\000\000\000\0071\001\242\002r\0071\000\000\000\000\002~\016\226\002\146\004\006\004\018\000\000\016\250\0011\000\000\004\030\000\000\000\000\0011\0071\0071\0011\0071\0071\000\000\000\000\000\000\000\000\018.\000\000\000\000\0011\004\"\0011\000\000\0011\000\000\000\000\000\000\000\000\000\000\0071\017\022\018B\000\000\000\000\000\000\0011\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\000\000\0011\000\000\000\238\000\000\000\000\0011\018R\000\000\0011\000\000\000\000\000\000\000\000\0011\0011\000\238\000\000\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\000\000\000\000\001-\000\000\0011\000\000\000\000\0071\0011\0071\000\000\000\000\001-\000\000\001-\000\000\001-\000\000\0011\0011\0011\0071\0011\0011\005\194\0071\000\000\000\000\001-\0071\000\000\0071\0011\000\000\001-\0071\000\000\000\000\001-\0011\000\000\000\000\000\000\001-\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\001-\000\238\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\000\000\0125\001m\000\000\001-\000\000\000\000\000\000\001-\000\000\0125\000\000\001m\000\000\001m\000\000\001m\000\000\001-\001-\001-\000\000\001-\001-\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\000\000\001m\0125\000\000\000\000\000\000\001-\000\000\0125\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\001m\001m\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\029\000\000\000}\001\029\000\000\001m\000\000\000\000\000\000\0125\000\000\000}\000\000\001\029\000\000\001\029\000\000\001\029\000\000\001m\001m\001m\000\000\001m\001m\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\000}\000\000\000\000\000\000\001m\000\000\000}\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\001m\001\029\001\029\001\029\001\197\000\000\000\000\000\000\000\000\001\197\000\000\015N\001\197\000\000\002b\000\000\000\000\001\029\000\000\000\000\000\000\000}\001\197\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\001\197\001\202\001\206\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\015R\000\000\001\029\001\197\000\000\015b\001\197\001\210\001\226\000\000\000\000\001\197\001\197\001\029\015^\000\000\001\238\000\000\000\000\000\000\000\000\000\000\000\000\001\246\000\000\000\000\000\000\001\197\0009\001\242\002r\001\197\000\000\0009\002~\0009\002\146\004\006\004\018\000\000\015f\001\197\001\197\004\030\0009\001\197\001\197\0009\000\000\000\000\000\000\0009\b)\000\000\000\000\001\197\000\000\000\000\000\000\000\000\004\"\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\0009\001\197\000\000\0009\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\0009\0009\0009\000\000\000\000\000\000\000\000\000\000\000\000\0009\0009\004*\000\000\004.\000\000\0036\002\158\000\000\000\000\002\214\0009\006z\000\000\0009\002\218\000\000\000\000\000\000\004E\000\000\000\000\004E\0009\000\000\006\154\0009\000\000\000\000\000\000\003:\b)\004E\b\178\000\000\0009\000\000\000\000\0009\000\000\000\000\b\246\000\000\003F\000\000\000\000\rr\001\190\004E\000\000\000\000\0009\000\000\002\146\004E\000\000\003\210\000\000\000\000\000\000\003\214\004E\003\222\004E\n\138\005R\004E\000\000\000\000\004E\000\000\004E\002\194\000\000\000\000\000\000\000\000\005V\000\000\004E\000\000\000\000\000\000\004E\000\000\005^\005b\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\000\000\r\130\000\000\005f\004E\000\000\000\000\004E\000\000\004.\000\000\000\000\004E\002\194\000\238\000\000\004E\000\000\003!\000\000\000\000\004E\004E\003!\000\000\000\000\003!\000\000\004E\004E\000\000\000\000\004E\000\000\000\000\000\000\003!\000\000\000\000\000\000\003!\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\000\000\000\000\003!\015n\000\000\000\000\004E\000\000\003!\000\000\000\000\004E\000\000\004E\004E\000\000\000\000\003!\025j\000\000\003!\000\000\000\000\000\000\004E\003!\003!\003!\004E\000\000\0036\002\158\000\000\000\000\002\214\000\000\006z\000\000\000\000\002\218\004E\003!\000\000\000\000\000\000\003!\004E\000\000\000\000\006\154\000\000\000\000\004N\000\000\003:\003!\003!\b\178\004E\003!\003!\000\000\000\000\004E\002\194\023.\000\000\003F\000\000\003!\003R\001\190\000\000\000\000\000\000\015\206\003!\002\146\000\000\004E\003\210\003!\000\000\000\000\003\214\000\000\003\222\003!\n\138\005R\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\005V\000\000\004^\000\000\000\000\000\000\007\030\000\000\005^\005b\0036\002\158\021\158\004E\002\214\000\000\006z\000\000\000\000\002\218\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\006\154\023\250\000\000\005f\000\000\003:\000\000\000\000\b\178\004.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\nz\001\190\000\000\000\000\000\000\000\000\000\000\002\146\006y\006y\003\210\000\000\000\000\000\000\003\214\000\000\003\222\000\000\n\138\005R\000\000\000\000\000\000\000\000\000\000\000\000\006y\006y\000\000\000\000\000\000\005V\000\000\000\000\000\000\006y\000\000\000\000\000\000\005^\005b\0036\002\158\n\146\000\000\002\214\000\000\006z\006y\006y\002\218\000\000\000\000\006y\000\000\006y\006y\006y\000\000\000\000\006\154\0226\006y\005f\000\000\003:\000\000\000\000\b\178\004.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\006y\000\000\nz\001\190\005\154\000\000\000\000\000\000\000\000\002\146\0036\002\158\003\210\000\000\002\214\000\000\003\214\000\000\003\222\002\218\n\138\005R\000\000\000\000\005\158\000\000\003\218\000\000\000\000\000\000\000\000\000\000\000\000\005V\003:\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\004\194\000\000\n\146\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\022\150\003\214\005f\003\222\005F\000\000\005R\000\000\004.\000\000\000\000\000\000\000\000\000\000\000\000\b\169\000\000\000\000\005V\000\000\000\000\0036\002\158\000\000\000\000\002\214\005^\005b\000\000\005\162\002\218\000\000\000\000\000\000\000\000\000\000\000\000\b\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003:\000\000\005\234\000\000\000\000\005f\000\000\006f\000\000\b\154\000\000\004.\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\011\241\000\000\003\214\011\241\003\222\005F\000\000\005R\002\209\002\209\000\000\000\000\002\209\011\241\000\000\000\000\000\000\002\209\000\000\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\011\241\005\162\000\000\002\209\000\n\000\000\011\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\241\002\209\000\000\011\241\002\209\002\209\000\000\005f\011\241\b\169\000\000\002\209\000\000\004.\002\209\000\000\000\000\002\209\002\209\000\000\002\209\002\209\000\000\002\209\011\241\004-\004-\000\000\011\241\004-\000\000\000\000\000\000\000\000\004-\002\209\000\000\000\000\011\241\011\241\004-\000\000\011\241\002\209\002\209\000\000\002\209\000\000\027f\004-\022\230\000\000\000\000\022\254\000\000\000\000\000\000\000\000\000\000\011\241\000\000\000\000\004-\000\000\000\000\004-\004-\002\209\000\000\000\000\000\000\002\209\004-\002\209\000\000\004-\000\000\000\000\000\238\004-\003!\004-\004-\000\000\004-\003!\000\000\000\000\003!\003!\000\000\000\000\000\000\000\000\003!\000\000\004-\003!\003!\000\000\000\000\000\000\003!\000\000\004-\004-\000\000\003!\000\000\000\000\000\000\003!\000\000\000\000\003!\015n\000\000\000\000\000\000\000\000\003!\000\000\000\000\003!\015n\000\000\000\000\000\000\004-\003!\000\000\000\000\003!\000\000\004-\000\000\000\000\003!\003!\003!\003!\003!\000\000\000\000\000\000\003!\003!\003!\003!\000\000\000\000\000\000\000\000\003!\000\000\000\000\000\000\003!\003!\000\000\000\000\000\000\003!\000\000\000\000\000\000\003!\003!\003!\025r\000\000\003!\003!\000\000\003!\015n\003!\003!\025\162\000\000\003!\003!\000\000\000\000\000\000\000\000\012)\015\206\003!\003!\000\000\012)\003!\003!\012)\000\000\015\206\003!\003!\003!\000\000\000\000\003!\000\000\012)\000\000\000\000\000\000\012)\000\000\000\000\000\000\000\000\003!\0121\000\000\000\000\003!\000\000\000\000\012)\000\000\000\000\000\000\000\000\000\000\012)\003!\003!\017R\000\000\003!\003!\000\000\000\000\012)\000\000\000\000\012)\000\000\000\000\000\000\000\000\012)\012)\0036\002\158\015\206\003!\002\214\000\000\006z\000\000\000\000\002\218\000\000\000\000\000\000\000\000\012)\000\000\000\000\000\000\012)\006\154\000\000\000\000\000\000\000\000\003:\000\000\000\000\b\178\012)\012)\002Z\000\000\012)\012)\000\000\000\000\000\000\003F\000\000\000\000\b\222\001\190\012)\005\001\000\000\000\000\026\154\002\146\005\001\012)\003\210\005\001\000\000\000\000\003\214\000\000\003\222\000\000\n\138\005R\012)\005\001\000\000\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\000\000\000\000\005\001\000\000\005^\005b\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\007\174\000\000\000\000\005\001\000\000\000\000\005\001\000\000\000\000\000\000\000\000\005\001\005\001\000\238\005f\000\000\000\000\005\005\000\000\000\000\004.\000\000\005\005\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\000\000\000\000\000\000\005\005\000\000\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\005\001\000\000\000\000\000\000\000\000\005\005\012\201\012\201\000\000\000\000\000\000\005\005\000\000\000\000\000\000\000\000\005\001\007\174\000\000\000\000\005\005\000\000\000\000\005\005\012\201\012\201\007\006\005\001\005\005\005\005\000\238\000\000\000\000\012\201\005\177\000\000\000\000\000\000\000\000\005\177\000\000\000\000\005\177\000\000\005\005\005\005\012\201\012\201\005\005\000\000\000\000\012\201\005\177\012\201\012\201\012\201\005\177\000\000\005\005\005\005\012\201\000\000\005\005\005\005\000\000\000\000\000\000\000\000\005\177\000\000\000\000\000\000\000\000\000\000\005\177\000\000\000\000\012\201\000\000\005\005\000\000\000\000\000\000\005\177\000\000\000\000\005\177\000\000\000\000\000\000\005\005\005\177\005\177\000\238\025J\000\000\000\000\000\000\000\000\000\000\0036\002\158\000\000\000\000\002\214\000\000\000\000\005\177\000\000\002\218\000\000\005\177\000\000\000\000\000\000\000\000\006&\000\000\000\000\000\000\000\000\005\177\005\177\021*\003:\005\177\005\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\177\000\000\003F\000\000\000\000\003R\001\190\005\177\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\005\177\003\214\000\000\003\222\005F\005\249\005R\000\000\000\000\000\000\000\000\000\000\002\158\000\000\000\000\002\214\000\000\000\000\005V\000\000\002\218\000\000\000\000\000\000\000\000\005\249\005^\005b\000\000\005\162\000\000\000\000\002\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\226\000\000\000\000\000\000\000\000\000\000\000\000\005f\003\014\001\190\000\000\b\154\000\000\004.\000\000\002\146\000\000\000\000\003\026\001\202\001\206\000\000\007\234\007\238\007\250\000\000\000\000\005R\000\000\000\000\000\000\000\000\000\000\002n\000\000\005\198\000\000\001\210\001\226\000\000\000\000\0036\002\158\000\000\000\000\002\214\001\238\005^\005b\000\000\002\218\000\000\000\000\001\246\000\000\000\000\000\000\000\000\000\000\001\242\002r\000\000\000\000\000\000\002~\003:\002\146\004\006\004\018\000\000\000\000\005f\b\002\004\030\000\000\000\000\b\026\004.\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\006\002\000\000\002\146\000\000\004\"\003\210\0036\002\158\000\000\003\214\002\214\003\222\005F\000\000\005R\002\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\003:\000\000\000\000\015V\005^\005b\000\000\005\162\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\005f\000\000\003\214\006\014\003\222\005F\004.\005R\000\000\0036\002\158\000\000\000\000\002\214\000\000\000\000\000\000\000\000\002\218\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\005\162\000\000\000\000\003:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\005f\000\000\000\000\005\253\000\000\002\146\004.\000\000\003\210\0036\002\158\000\000\003\214\002\214\003\222\005F\000\000\005R\002\218\000\000\000\000\000\000\000\000\005\253\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\003:\000\000\000\000\000\000\005^\005b\000\000\005\162\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\005f\000\000\003\214\011r\003\222\005F\004.\005R\000\000\0036\002\158\000\000\000\000\002\214\000\000\000\000\000\000\000\000\002\218\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\000\000\000\000\000\000\003:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\005f\000\000\000\000\011~\000\000\002\146\004.\000\000\003\210\0036\002\158\000\000\003\214\002\214\003\222\005F\000\000\005R\002\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\003:\000\000\000\000\000\000\005^\005b\000\000\005\162\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\005f\000\000\003\214\011\138\003\222\005F\004.\005R\000\000\0036\002\158\000\000\000\000\002\214\006!\000\000\000\000\000\000\002\218\005V\000\000\002\158\000\000\000\000\002\214\000\000\000\000\005^\005b\002\218\005\162\000\000\000\000\003:\006!\000\000\000\000\000\000\000\000\000\000\000\000\002\222\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\005f\002\226\000\000\000\000\000\000\002\146\004.\000\000\003\210\003\014\001\190\000\000\003\214\000\000\003\222\005F\002\146\005R\000\000\003\026\000\000\000\000\000\000\007\234\007\238\007\250\000\000\000\000\005R\005V\000\000\000\000\000\000\000\000\006\169\006\242\000\000\005^\005b\006\169\005\162\000\000\006\169\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\000\000\006\169\000\000\000\000\000\000\006\169\000\000\000\000\000\000\000\000\005f\000\000\000\000\000\000\000\000\000\000\004.\006\169\000\000\000\000\000\000\005f\b\002\006\169\007^\000\000\b\026\004.\001\153\000\000\000\000\000\000\006\169\001\153\000\000\006\169\001\153\000\000\000\000\000\000\006\169\006\169\000\238\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\153\000\000\000\000\000\000\000\000\000\000\006\169\000\000\000\000\000\000\006\169\000\000\001\153\000\000\000\000\000\000\000\000\000\000\001\153\000\000\006\169\006\169\000\000\000\000\006\169\006\169\000\000\001\153\000\000\000\000\001\153\000\000\000\000\000\000\000\000\001\153\001\153\001\153\001\201\000\000\005\181\006\169\000\000\001\201\000\000\005\181\001\201\000\000\005\181\000\000\000\000\001\153\000\000\000\000\000\000\001\153\001\201\000\000\005\181\000\000\001\201\000\000\005\181\000\000\000\000\001\153\001\153\000\000\000\000\001\153\001\153\000\000\001\201\000\000\005\181\017b\000\000\000\000\001\201\000\000\005\181\000\000\000\000\000\000\000\000\000\000\001\153\001\201\000\000\005\181\001\201\001\153\005\181\000\000\000\000\001\201\001\201\005\181\005\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\000\000\005\181\000\000\001\201\000\000\005\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\001\201\005\181\005\181\001\201\001\201\005\181\005\181\000\000\000\000\000\000\000\000\000\000\000\000\001\201\011\225\005\181\002\158\011\225\000\000\027N\001\201\000\000\005\181\000\000\027R\021\006\000\000\011\225\000\000\000\000\000\000\001\201\000\000\005\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\225\000\000\000\000\000\000\000\000\000\000\011\225\000\000\000\000\000\000\000\000\004E\001\002\001\190\000\000\011\225\004E\000\000\011\225\004E\000\000\000\000\000\000\011\225\000\000\000\000\000\000\000\000\000\000\004E\000\000\027V\000\000\004E\000\000\000\000\000\000\000\000\000\000\011\225\000\000\000\000\000\000\011\225\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\027Z\011\225\011\225\000\000\000\000\011\225\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\000\000\004E\002\194\000\000\000\000\000\000\000\000\011\225\000\000\000\000\007\201\007\201\000\000\000\000\007\201\000\000\000\000\004E\000\000\007\201\000\000\004E\000\000\000\000\000\000\015\250\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\007\201\004E\004E\006\242\000\000\000\000\000\000\004E\000\000\000\000\004E\007\030\000\000\007\201\000\000\000\000\007\201\007\201\004E\004E\004E\000\000\000\000\007\201\004E\000\000\007\201\004E\000\000\004E\007\201\000\000\007\201\007\201\000\000\007\201\004E\004E\000\000\000\000\000\000\004E\004E\007^\000\000\000\000\000\000\007\201\000\000\000\000\000\000\000\000\000\000\004E\004E\007\201\007\201\000\000\000\000\004E\002\194\000\238\000\000\000\000\000\000\007\174\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\004E\004E\002\194\000\238\007\201\000\000\000\000\000\000\001U\000\000\007\201\000\000\000\000\001U\004E\004E\001U\004E\004E\004E\000\000\004E\000\000\000\000\000\000\000\000\001U\000\000\001U\000\000\001U\004E\004E\000\000\000\000\004E\004E\001\202\001\206\022:\000\000\000\000\001U\000\000\000\000\000\000\004E\000\000\001U\000\000\000\000\000\000\004E\000\205\000\000\002\138\001\226\000\000\000\205\000\000\001U\000\205\000\000\000\000\001\238\001U\001U\000\238\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\205\000\000\001\242\002r\000\000\000\000\001U\002~\000\000\002\146\004\006\004\018\000\205\000\000\000\000\000\000\004\030\000\000\000\205\000\000\001U\001U\001U\000\000\001U\001U\000\000\000\205\000\000\000\000\000\205\000\000\000\000\004\"\000\000\000\205\000\205\000\238\000\000\000\000\000\000\001U\000\209\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\000\205\001U\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\205\000\205\000\000\000\000\000\205\000\205\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\004M\000\000\000\209\000\000\000\000\000\246\000\205\006\165\002\014\000\000\000\000\000\209\006\165\000\000\000\209\006\165\000\000\000\205\017\134\000\209\000\209\000\238\004M\000\000\000\000\006\165\000\000\000\000\000\000\006\165\000\000\000\000\000\000\000\000\017\138\000\209\000\000\000\000\000\000\000\209\017\178\006\165\000\000\000\000\000\000\000\000\000\000\006\165\000\000\000\209\000\209\000\000\016\226\000\209\000\209\000\000\006\165\016\250\000\000\006\165\000\000\000\000\000\000\000\000\006\165\006\165\000\000\005\169\000\000\000\000\000\209\000\000\005\169\018.\000\000\005\169\000\000\000\000\000\000\000\000\006\165\000\209\0172\000\000\006\165\005\169\000\000\017\022\018B\005\169\000\000\004M\004M\000\000\006\165\006\165\016\146\000\000\006\165\006\165\000\000\005\169\000\000\000\000\000\000\005\r\006\242\005\169\018R\000\000\005\r\000\000\000\000\005\r\000\000\006\165\005\169\000\000\000\000\005\169\000\000\000\000\000\000\005\r\005\169\005\169\000\000\005\r\000\000\000\000\007!\000\000\000\000\007!\000\000\000\000\000\000\000\000\000\000\005\r\005\169\000\000\000\000\000\000\005\169\005\r\007^\000\000\000\000\007!\007!\000\000\007!\007!\005\169\005\169\000\000\005\r\005\169\005\169\000\000\000\000\005\r\005\r\000\238\011\145\000\000\000\000\000\000\000\000\011\145\007!\000\000\011\145\000\000\005\169\000\000\000\000\005\r\000\000\000\000\000\000\000\000\011\145\000\000\000\000\000\000\011\145\000\000\000\238\000\000\000\000\005\r\005\r\000\000\000\000\005\r\005\r\000\000\011\145\000\000\000\000\000\000\000\000\000\000\011\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\r\011\145\000\000\000\000\011\145\000\000\007!\000\000\007!\011\145\000\000\000\000\000\000\000\000\001\202\002^\000\000\000\000\002b\000\000\005\254\000\000\000\000\005\194\007!\011\145\t\138\000\000\007!\011\145\007!\000\000\001\210\001\226\007!\000\000\000\000\000\000\000\000\011\145\011\145\001\238\000\000\011\145\011\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002j\002r\000\000\000\000\000\000\002~\011\145\002\146\004\006\004\018\000\000\000\000\000\000\000\000\020\222\000\000\026F\nn\000\000\004\029\000\000\004\021\000\000\000\000\004\029\000\000\004\021\004\029\000\000\004\021\000\000\004\"\000\000\000\000\000\000\000\000\000\000\004\029\000\000\004\021\015f\004\029\000\000\004\021\000\000\000\000\000\000\000\000\000\000\000\000\026R\000\000\000\000\004\029\000\000\004\021\000\000\000\000\000\000\004\029\000\000\004\021\000\000\000\000\000\000\000\000\000\000\020\242\004\029\000\000\004\021\004\029\000\000\004\021\000\000\000\000\004\029\000\000\004\021\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\0045\000\000\000\000\0045\000\000\004\029\000\000\004\021\000\000\004\029\000\000\004\021\000\000\0045\000\000\000\000\000\000\0045\000\000\004\029\004\029\004\021\004\021\004\029\004\029\004\021\004\021\000\000\000\000\0045\000\000\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\029\000\000\004\021\000\000\0045\000\000\000\000\0045\000\000\000\000\000\000\016\186\0045\019\186\000\000\004\005\000\000\000\000\000\000\000\000\004\005\000\000\000\000\004\005\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\0045\004\005\000\000\000\000\000\000\004\005\000\000\000\000\000\000\000\000\0045\0045\000\000\000\000\0045\0045\000\000\004\005\000\000\000\000\000\000\004%\000\000\004\005\000\000\000\000\004%\000\000\004\r\004%\000\000\0045\004\005\004\r\000\000\004\005\004\r\000\000\000\000\004%\004\005\000\000\020\162\004%\000\000\000\000\004\r\000\000\000\000\000\000\004\r\000\000\000\000\000\000\000\000\004%\004\005\000\000\000\000\000\000\004\005\004%\004\r\000\000\000\000\000\000\000\000\000\000\004\r\000\000\004\005\004\005\000\000\004%\004\005\004\005\000\000\000\000\004%\000\000\004\r\000\000\000\000\000\000\000\000\004\r\000\000\000\000\000\000\000\000\000\000\004\005\004=\000\000\004%\000\000\000\000\004=\000\000\004Y\004=\004\r\024\026\000\000\000\246\000\000\000\000\002\162\004%\004%\004=\000\000\004%\004%\004=\004\r\004\r\003\146\000\000\004\r\004\r\004Y\000\000\000\000\000\000\000\000\004=\000\000\000\000\004%\000\000\000\000\004=\003\150\000\000\000\000\004\r\000\000\000\000\016~\017\230\000\000\000\000\000\000\004=\000\000\000\000\020N\024F\004=\000\000\016\226\000\000\000\000\000\000\000\000\016\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004=\000\000\000\000\n\246\000\000\000\000\000\000\017\002\000\000\001\202\001\206\000\000\000\000\000\000\004=\004=\000\000\000\000\004=\004=\000\000\017\022\017B\000\000\000\000\004Y\004Y\001\210\001\226\000\000\000\000\000\000\000\000\000\000\000\000\004=\001\238\000\000\000\000\000\000\000\000\000\000\021\134\001\202\001\206\022\154\020\202\000\000\000\000\001\242\002r\000\000\000\246\000\000\002~\002\162\002\146\004\006\004\018\000\000\000\000\002\138\001\226\004\030\000\000\027\154\000\000\000\000\001\202\001\206\001\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\"\003\150\000\000\001\242\002r\000\000\001\210\016~\002~\000\000\002\146\004\006\004\018\000\000\000\000\000\000\024F\004\030\000\000\016\226\000\000\000\000\000\000\000\000\016\250\000\000\000\000\000\000\001\242\002\130\000\000\000\000\000\000\002~\004\"\002\146\004\006\004\018\000\000\000\000\017\002\000\000\004\030\000\000\027F\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\022\017B\000\000\000\000\004\129\004\"\000\000\000\000\004\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\134\000\000\000\000\025\238"))
and lhs =
- (8, "\006\005\004\003\002\001\000\193\193\192\192\191\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\189\189\188\187\187\187\187\187\187\187\187\186\186\186\186\186\186\186\186\185\185\185\184\184\183\183\182\182\182\181\181\180\180\180\180\180\180\179\179\179\179\179\179\179\179\178\178\178\178\178\178\178\178\177\177\177\177\176\175\175\174\174\174\174\173\173\173\173\173\173\172\172\172\172\172\172\172\171\170\170\170\169\169\168\168\167\167\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\165\165\164\163\162\161\160\160\159\159\158\158\158\158\157\157\157\157\156\156\155\155\154\154\154\154\153\152\151\151\150\150\149\149\148\147\146\145\144\143\143\143\142\142\141\141\140\140\140\140\140\139\139\139\139\139\139\139\139\138\138\138\138\138\138\137\137\136\136\136\135\135\134\134\134\133\133\132\132\131\131\130\130\129\129\128\128\127\127~~}}||{{{zzzzyyxxwwvvvvvuuuutttsssssssrrrrrrrqqqqppooonnmmmmmmmmmllkkkkkkkkkkkjiihhgggggfeeddccccccccccccccbbaa```````````````````````````````__^^]]\\\\[[ZZYYXXWWVVUUTTTTTTTTTTTSRQPPPPPPPPPPOOONNNMMMMLLLLLLLLLKKJJJJJIIHHGFEEDDDDDCCBBAAA@@@@@@???>>==<<;;::999887766554433221100//...---,,,+++****)(''''''''''''''''''&&&&&%%%%%%%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$##\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \031\031\031\030\030\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\028\028\027\027\026\026\026\026\026\026\026\025\025\025\025\024\024\023\023\023\023\023\022\022\021\021\020\019\019\019\018\018\017\017\017\016\016\015\015\015\015\015\014\014\r\r\r\r\r\012\011\011\n\n\n\t\t\t\b\b\b\b\007\007")
+ (8, "\006\005\004\003\002\001\000\194\194\193\193\192\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\190\190\189\188\188\188\188\188\188\188\188\187\187\187\187\187\187\187\187\186\186\186\185\185\184\184\183\183\183\182\182\181\181\181\181\181\181\180\180\180\180\180\180\180\180\179\179\179\179\179\179\179\179\178\178\178\178\177\176\176\175\175\175\175\174\174\174\174\174\174\173\173\173\173\173\173\173\172\171\171\171\170\170\169\169\168\168\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\166\166\165\164\163\162\161\161\160\160\159\159\159\159\158\158\158\158\157\157\156\156\156\156\155\154\153\153\152\152\151\151\150\149\149\148\147\146\145\144\144\144\143\143\142\142\141\141\141\141\141\140\140\140\140\140\140\140\140\139\139\139\139\139\139\138\138\137\137\137\136\136\135\135\135\134\134\133\133\132\132\131\131\130\130\129\129\128\128\127\127~~}}|||{{{{zzyyxxwwwwwvvvvuuutttttttsssssssrrrrqqpppoonnnnnnnnnmmllkkkkkkkkkkkjiihhgggggfeeddccccccccccccccbbaa```````````````````````````````__^^]]\\\\[[ZZYYXXWWVVUUTTTTTTTTTTTSRQPPPPPPPPPPOOONNNMMMMLLLLLLLLLKKJJJJJIIHHGFEEDDDDDCCBBAAA@@@@@@???>>==<<;;::999887766554433221100//...---,,,+++****)(''''''''''''''''''&&&&&%%%%%%%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$##\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \031\031\031\030\030\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\028\028\027\027\026\026\026\026\026\026\026\025\025\025\025\024\024\023\023\023\023\023\022\022\021\021\020\019\019\019\018\018\017\017\017\016\016\015\015\015\015\015\014\014\r\r\r\r\r\012\011\011\n\n\n\t\t\t\b\b\b\b\007\007")
and goto =
- ((16, "\000\025\001A\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000p\000\000\000\000\000T\000\176\000\022\001-\000\142\000\024\000u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000*\250\000\000\000\000\000\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\164\000\254\000\240\000\199\000\000\001\190\t\006\001\014\001\244\000T\000\000\000^\000\000\000>\002N\000\000\002,\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\023\003N\002\n\000\000\000\000\001`\000\164\000\000\000\000\000~\000\000\001z\000\000\bx\002d\000\000\001\164\000\228\000\000\000\000\002V\002P\001.\003\b\001\130\003N\003\212\003 \002\188\001\130\003.\003\018\b8\000\000\000\000\000\168\003\132\003\172\000\132\000\000\000\000\000\000\000\000\000\000\000\000\003\214\000\000\004~\000\000\000\168\t\022\000\000\000\000\003\160\003\240\003\142\025d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\000\000\003\186\004.\000\000\000\000\000\000\000\189\000\000\000\000\0048\000\127\006\000\005\000\0068\004\180\004\244\006,\000Q\000\011\006d\025\152\000\000\000\000\005b\006\202\t4\000\000\025\216\007x\t\244\n\016\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\016+\012\006\026\000\000\n@\006\028\000\000\nr\026*\001\202\000\000\n\142\005\192\000\000\000\000\000\000\000#\000\000\000\002\000\000\006\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0048\003\162\000\000\000\000\000\134\000\000\002r\000\000\0048\005\140\0048\000\000\000\000\000\000\000\000\000\000\026f\000\000\0076\006\232\000\000\019*\007J/`\000\000\000\000\000\000\006\166\000\000\000\000\000\000\000\000\006|\000\000\000\000\000\000\000\000\000\000\n\200\000\000\000\000\000\000\000\000\000\000\000\000\0007\007P\000\000\000\000\000\000\006|\b\"\0268\007\238\007x#\140\000\000\004\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\166\000\000\000\000\000\000\000\000\t\026\026\248\000\000\000\000\bB\007\234\027\"\000\000\000\000\000\000\027@\b,\027X\000\000\b,\000\000\027\206\b,\000\000\027\230\b,\b,\000\000\000\000\b,\000\000\000\000\027\240\000\000\b,\028t\000\000\b,\t\146\000\000\000\000\n\016\000\000\000\000\000\000\000\000\b,\011V\000\000\000\000\000\000\b,\000\000\000\242\b\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\"J\000\000\b\182\000\000+F\006|\000\000\000\000\000\000\000\000\b\196\t6\n\216\b\156\b\176\b\190\b\216\000\180\t\018\000\004\b\214\000\000\000\000\000\000\000\000\000\143\001\172\t\156\002\240\b\224\002\002\000\000\001\198\0006\003L\000\250\n(\000\000\000\000/~\000\000/\154\t\220\000\000+Z\006|+\150\006|\000\000\t\198\000\000\t\210\000\000\000\000\t\230\000\000\000\000\000\000\n\236\000\000\002\222\001\198\000\000\000\000\t\218\000\000\000\000\000\000\000\000\000\000\000\000\001\198\000\000\000\000\001\198\000\000\b\224\000\212\000\000\000*\000\011\000\000\000*\000\000\000\000\0034\001\198\000\000\000\000\000\000\000\000\000\000\000\000\000*\n\250\011n\n\172\nT\025\238\023X\000\000\t\218\t\166\011\246\t\230\t\200\005<\012H\000\000\000\000\000\000\000\000\000\000\011\024\004\190\000\000\000\000\000\000\t\254\t\204\0018\000*\003^\000\000\001\198\000\000\000\000\000\000\007x\000\000+\176\006|\012B\n\012\n\012\012p\n\022\nT\007\212\012N\b,\012\188\n2\n`*v\011\000\000\000\012\224\b,+\188\006|\n\234\000\000\000\000\000\000\000\000\000N\011\n\011\022\000\000\000\000(\160\r\020\n\154\np\028\176\b,\rv\n\162\n\136\rD\000\000\021h\000\000\000\000\028\140\028\212\005\156\000\000\000\000\000\000\000\000\021\216\000\000\000\000\000\000\004b\r\184\000\000\000\000\000\000\000\000\029F\024 \000\000\000\000\000\000\000\000\n\128\r\190\000\000\n\142\029\\\n\142\029z\n\142\000\000\030T\000\000\029\154\n\142\014\016\004D\014\022\000\000\000\000\029\168\n\142\030L\n\142\030b\n\142\030\160\n\142\030\178\n\142\030\240\n\142\031\006\n\142\031\020\n\142\031D\n\142\031R\n\142\031\170\n\142\031\184\n\142\031\232\n\142\031\246\n\142 \012\n\142 J\n\142 \\\n\142 \154\n\142 \176\n\142 \238\n\142\n\144\014b!\204\000N\011L\000\000\014\154%\130\000\000\014\214\000\000,8\000\000\006|\024\168\000\000\006|,:\006|\000\000\015(\000\000\000\000\000\000\015h\000\000\000\000\000\000\000\000\000\000\b,\000\000\000\000,D\000\000\006|\000\000\000\000\024\168\011R\000\000,T\006|\015p\000\000\000\000\n\252\000\000,`\006|\015\194\000\000\000\000\015\200\000\000\000\000\000\000,\244\006|\016\n\000\000\n\178\016\152\000\000\028\188\000\000\b,!\140\000\000\b,\"\n\000\000\b,\012\026\000\000\000\000\000\000\000\000\000\000\".\b,\005\022\006\028\000\000\000\000\000\000\n\142\016\218\000\000\000\000\000\000!\230\n\142\000\000\000\000\000\000\000\000\"\"\n\142\000\000\000\000\"n\n\142\000\000\000\000\"\188\n\142\000\000\000\000\000\000\"\164\000\000\000\000\"\212\n\142\000\000\000\000\"\244\n\142#V\n\142\000\000\000\000#z\n\142#\240\n\142\000\000\000\000$,\n\142\005@\016\224\000\000\000\000$B\n\142\017\"\000\000\000\000$\162\n\142$\208\n\142\000\000$\254\n\142\000\000\000\000%\b\n\142\000\000%^\n\142%\158\n\142\000\000%\188\n\142&\004\n\142\000\000&V\n\142\000\000&\\\n\142\000\000\006X\000\000\000\000\n\142\n\142\000\000&z\n\142\000\000&\170\n\142\000\000\n\238\000\000\000\000\017v\000\000\017\128\000\000\000\000\000\000\000N\011\134\000\000(\208\007\174\0048\017\190\000\000)\012\000\000\000\000\000\000)\030\000\000\000\000\017\220\000\000\018d\000\000\000\000\000\000\000\000\018\156\000\000\000\000\000\000&\184\n\142'\000\n\142\000\000\n\178\018\246\000\000\000\000\019\014\000\000\015\206\000\000\000\000\012H\000\000\000\000\000\000\0192\000\000\000\000\000\000\000\000\n\142\019j\000\000\019\128\000\000\000\000\000\000\000\000\012\020\000\000\000\000\000\000 \148\000\000\002\194\000\000\001\244\000\000\011\252\000\000\003,\000\000\000\000\000\000\000\000\000\000\000\000\011\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\142\000\000\012Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\212\002\164\000*\019\206\000\000\011r\n\228\000\000\004\136\004\238\000*\003\222\001\198\006 \000*\000\000\019\228\000\000\0052\000\000\011~\n\250\011z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\178\001P\000b\000\000\000\000\000\000\026~\000\0000\006\000\000\n\252\000\000\011\006\000\000\000\000\000\000\000\000\004\216\000\000\000\000\000\000\b\232\0048\000\000\0048\002P\000\000\t@\0048\0048\011*\000\000\020\130\000\000\011.\012\128\000\000\020\192\006\182\000\000\000\000\000\000\000\000\000\000\000\000\n\142\000\000\007\222\000\000\n\142\000\000\000\000\004,\000\000\001\198\000\000\005\006\000\000\001\198\000\000\005\026\001\198\000\000\000*\000\000\0114\b\206\003B\000\000\011\206\011\210\011V\011\246\012\130\006@\001\198\006\186\000\000\011d\000\000\007t\007\204\000\000\000\000\007\130\b\006\012B\011j\000\000\b\004\b\146\012\\\000\000\000\000\006P\0024&\224\b,\020\224\000\000\bb\002\210\012\028\011l\b\222\006\"\000\000\012X\011r\r\152\000\000-\004\006|\r\n\rB\000\000\b\180\000\000\012\196\011\132\012\234\r:\002\168\000\000\000\000\000\000\000\000\000\000\011\136\t\222\000\000\011\138\n\214\000\000\006~'\130\r0\r2\011\158\r\164\011\004\000\000\011\192\r\178\011&\000\000\rP\011\194\000\000\001R\r\196\011\140\000\000\r\248\000\000\011\178\000\000\007\004\001\198\012P\000\000\001\234\000\000\000\000\000\000\007h\001\198\r\238\011\206\000\000\000\000\b\004\004\160\014\002\000\000\000\000\r\200\011\210\b\212\006\022\000\000\r\242\011\226\r\228\r:\014\000\014 \011\244\015^\000\000\0148\001\214\000\000\000\000\000\000\000\000\000j\011\248\014\020-\028\006|\000\000\000\246\011\250\014\186\000\000\000\000\000\000\000\000\000\000\000\000-@\007\014\000\000\011\252\015\b\000\000\000\000\000\000\000\000\000\000\000\000\004b\000\000-h\006|\012\132\000\000\006|\012\012\003\204\000\000\000\000\012\014\012B\014\196\000\000\004\166\026\206\000\000\006\170\000\000\000\000\000\000\000\000-\168\006|\006|\000\000\000\000\b\n\000\000\014\234\000\000\006n\b\n\b\n\000\000\012X'@\006|-\180\006|\012\202\000\000\000\000\000\000\000\000\r\n\000\000\000\000\0016\000\000\t\n\014\200\012f\015\186\014\150\000\000\000\000\006\138\t\012\014\214\000\000\000\000\012l\015\198\014\176\000\000\000\000#4\000\000\001<\000\000-\196\020\196\006|\000\000-\240\b\228\000\000.\b\000\000\000\000\000\000\000\000\000\000\b\n\000\000\000\000\r$\014\242\012p\015\230\014\194\000\000\000\000.\024\r&\015\000\000\000\000\000\000\000'\158\000\000\000\000\000\000\000\000\000\000\000\000\r8\000\000\015\016\012\170\004|\000\000\015\226\015\164\rT\0150\000\000\000\000\0156\012\178\007\014\000\000\000\000\003\024\026*\007\170\000\000\000\000\000\000\014\220\015\004\012\238\000\000\015\012\014\220\000\000\015\196\rX\015J\000\000\000\000\000\000\006|\003\140\004\248\b\174\000\000\000\000\000\000\000\000\015\018\012\252\000\000\b\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006|\015\000\012\254\0166\015\014\000\000#\158\000q\r\024\014\232\000c\003\006\r8\015\134\000\000\016,\021\028\000\000\000\000\021Z\000\000\r\\\000\000\000\019\000\000\000\000\000\000\000\000\000\000\000\000-\200\006|\000\000\016.\021~\000\000\000\000\021\206\000\000\002\254\r<\015\214\000\000\000\000)Z\005@\015\152\000\000.d\006|\0222\000\000\000\000\022`\000\000\000\000\rj\000\000\b\020\000\000\000\000\000\000\000\000\000\000\000\000\t\146\000\000\000\000)v\022Z\015\154\000\000.\160\006|\022\160\000\000\000\000\023\000\000\000\000\000\rB\023\006\rp\000\000\rH\rL\002`\002\130\rT\b\216\r\\\015\232\022\196\r\240\000\000\r\144\r\148\015\146\000\000\0032*\154\000\000\005\132\000\000\r\164)\196)\208\005\216\014\248\005\222\000\000\006\022\006X\000\000\003\244\000\000\000\000\003\244\000\000\000\000\003\244\015\152\000\000\007\134\003\244\015\244\023\170\r\244\000\000\003\244\000\000\000\000.\170\000\000\000\000\000\000\003\244\000\000\000\000\014(\000\000\tj\005J\014.\000\000\r\172*\190\0148\000\000\000\000\000\000\000\000\014\\\000\000\000\000\006\022\000\000\003\244.\236\000\000\n:\003\244*\000\000\000\014\138\015t\r\180\016p\015H\000\000*:\014\164\015\130\000\000\000\000\000\000\026\136\b\156\000\000\000\000\000\000\000\000\000\000\000\000\n\128\014\166\000\000\015\144\000\000\000\000\000\000\000\000\014\168'\224\000\000\000\000\000\000\000\000\n\128\000\000\000\000\014\196'\244\000\000\000\000\000\000\000\000\000\000\000*\001\198\000\000\000\000\b,\000\000/\018\006|\000\000\n>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015F\r\216\n\158\000*\000\000\n\148\000\000\001\198\000\000\016d\000\000\000\000\000\000\000\000\000\000\b\024\000\000\000\000\000\000\000\000\000\000\000\000\016\012\001\182\015>\015\004\007\174\014J\000\000\004<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\018\bH\014N\000\000\006<\016p\016\"\014\200\000\000\000\000\016\022\003*\007V\000\000\000\000\000\000\014P\000\000\014\\\002 \000\000\000\000\0048\005V\000\000\000\000\000\000\000\000\000\000\t>\000\000\000\000\006\198\t\016\000\000\000\000/2\006|\006|\000\000/V\006|\t\198\000\000\000\000\000\000\006|\000\000\000\000\006\176\016(\014\214\000\000\000\000\016\"\t\208\002\030\000\000\000\000\000\000\000\000\b\226\016p\006\188\0166\014\242\000\000\000\000\0160\011F\003\192\000\000\000\000\000\000\000\000\001\198\000\000\tJ\000\000\000\000\000\000\023\178\000\000\024\024\000\000\000\000\000\000\000\000\000\000\b\026\000\000\000\000\000\000*h\000\000\006|\000\000\b\194\000\000\000\000\000\000\024v\b,\000\000\000\000\003\160\015\148\007`\000\000\000\000\000\000\000\000\000\000\000\000\011\024\000\000\000\000\000\000\000\000(J\000\000\014\246\000\000\000\000\000\000\000\000\004\004\005Z\024\\\025\006\000\000\000\000\015\006\025\016\000\000\000\000\000\000\015\012\025\026\000\000\000\000\000\000\000\000"), (16, "\006\t\005v\002\003\002\004\001\007\000;\001\182\001\b\006\172\000\134\006\150\001\182\000\143\006+\001\214\000?\002G\006\n\006\183\001\214\006\012\001\229\001\007\006\t\002H\002\003\002\004\000l\000\243\006\r\006\026\001\n\001D\000\246\001\182\001\207\001\225\002V\000h\002G\006\n\006\025\001\214\006\012\001\229\0007\006*\002H\000\134\001\242\001\218\000\139\006\r\006\026\001T\001\218\000\184\000\249\006\014\000\134\002V\006\158\001\199\001\227\000\134\001\219\000\144\001\199\001\026\004\020\001\219\005\239\001\242\001U\001e\001G\001W\001X\001\218\001\229\005\198\006\014\001\208\000\140\001\007\006\176\006\015\006}\001\007\0007\002X\001\027\002\233\001\219\006\016\005z\001\012\005\242\002\003\002\004\002\007\001\243\001\012\001\007\001\233\001\240\001\b\001\242\005\200\006\015\006\031\001\n\005\244\002X\001\012\001\n\001f\006\016\001g\002\181\006;\0007\005\201\002\007\001\243\006 \006\t\005\203\002\003\002\004\001\n\005\247\006\128\006\031\006\019\000h\006\185\005\245\006\021\000s\001!\001n\002G\006\n\006\025\004\021\006\012\001\021\006 \006\023\002H\001]\002Z\003\217\002`\006\r\006\026\006\019\001\221\001\243\002f\006\021\002\\\002V\006\024\001\021\004\198\001\026\000\134\006\178\006e\001\199\006\023\001\030\001\229\002Z\001\012\002`\000\184\001\007\001\012\002h\004\250\002f\006\014\002\\\002\006\006\024\006o\001\007\001\229\001\022\003\228\003\230\003\232\001\012\002\007\001\007\000@\001\244\001\b\000:\001\242\001p\002h\006\t\001\n\002\003\002\004\001\241\001\007\001q\006\015\001[\006Q\001\230\002X\004\205\001\242\003\233\006\016\002G\006\n\006\025\001\n\006\012\002\007\001\021\004\206\002H\000\189\001\021\004\230\000\243\006\r\006\026\006\031\000\243\001\146\001.\001\229\005:\002V\0007\004\222\0009\001\021\000{\002Z\000\188\006\135\006 \000\134\001\030\001\243\000\139\002[\001\030\002\\\000\189\006\019\001\026\000\249\006\014\006\021\002\016\001\187\006N\001\242\004\225\001\243\001\012\001\030\003\150\0018\006\023\004\229\000=\002Z\004t\002`\001\012\001\007\006Y\004\227\001\b\002f\004\149\002\\\001\012\006\024\006\015\000z\001\007\006\t\002X\002\003\002\004\002\233\006\016\000\128\004\225\001\012\004\228\006{\002\007\001\012\002h\000\189\001\n\002G\006\n\006\025\000\138\006\012\006\031\004\227\001\007\002H\001\182\001\243\001\222\001\021\006\r\006\026\004v\005:\001\214\005A\005B\006 \002V\001\021\001.\001\007\004\228\003\151\001\b\003\236\006\019\001\021\000\184\002\233\006\021\006\143\006\144\001\026\003\233\001\030\005K\000~\004|\006\014\001\021\006\023\004w\006!\002Z\003\237\002`\006\145\001\n\001\182\001\218\001\183\002f\001\030\002\\\0018\006\024\001\214\006]\006^\006\t\001\012\002\003\002\004\000\129\001\219\006w\006\015\006_\006`\0007\002X\001\012\002h\006v\006\016\002G\006\n\006\025\006a\006\012\002\007\006\154\003\148\002H\001\026\000\161\005o\004v\006\r\006\026\006\031\000\134\001\218\000\168\001\199\001\012\002V\000\189\001\003\005A\005B\001\213\000\184\001\007\001.\006 \001\b\001\219\001\229\000\166\006\155\001\021\001\012\000\137\006\019\005C\005S\006\014\006\021\000\184\005K\006\029\001\021\001\180\000\189\000\134\005\198\001\186\001\199\006\023\001\n\000\170\002Z\003\185\002`\003\154\001\242\001\030\004R\0018\002f\000\159\002\\\005\198\006\024\006\015\001\021\005:\006w\002X\000\165\000\243\003\239\006\016\005\200\006m\001\029\002\233\001\182\002\007\001\212\002h\006\t\001\021\002\003\002\004\001\214\001\026\005\201\006\031\000\189\005\200\003\242\005\203\002\233\006\213\006\214\005\226\002G\006\216\003\149\005=\006\012\005\146\006 \005\201\002H\001\240\001\243\001\030\005\203\006\r\006\218\006\019\005\219\001\012\005\148\006\021\004U\002V\005q\001\182\001\218\001\237\000\243\005:\000\176\000\184\006\023\001\214\006P\002Z\006\t\002`\002\003\002\004\006\233\001\219\001\221\002f\006\014\002\\\001\182\006\024\002\019\000\173\006\225\004\025\002G\006\226\001\214\005\198\006\012\003\149\005A\005B\002H\002\233\000\171\001.\002h\006\r\006\234\006]\006^\001\218\001\021\001\025\006\015\002V\005C\005S\002X\006_\006`\005K\006\016\000\189\000\175\005\200\001\219\000\189\002\007\000\184\006a\0007\001\218\000\189\001\007\006\221\006\014\001\b\001\030\005\201\0018\002\003\002\004\000\134\005\203\005$\001\199\001\219\005\210\000\182\005\229\004\198\001\182\006 \003\195\002G\006\168\001\241\005A\005B\001\214\001\n\006\019\002H\006\015\002\233\006\021\000\181\002X\006E\000\190\004\180\006\016\002\003\002\004\005R\002V\006\023\002\007\005K\002Z\000\198\002`\000\199\006\238\006\155\004\183\002G\002f\0063\002\\\001\182\006\024\004\011\000\211\002H\001\218\001P\001\026\001\214\001\024\003}\004\205\006 \006\t\001\012\002\003\002\004\002V\002h\000\189\001\219\006\019\004\206\000\212\002\233\006\021\004\213\006Z\000\219\002G\006\n\006'\000h\006\012\002\246\001\012\006\023\002H\002X\002Z\000\189\002`\006\r\006\026\001\218\002\003\002\004\002f\002\007\002\\\002V\006\024\003\198\000\189\001\007\005\205\006[\001\b\006\t\001\219\002\003\002\004\005:\003\004\000h\001\007\006\\\003\163\002h\004\198\002X\006\014\006\225\002]\002G\006\226\001\229\004\130\006\012\001.\002\007\001\n\002H\002\233\000\189\003\217\001\021\006\r\006\229\000\189\004\185\004\180\001\007\002\003\002\004\002V\002l\003\201\001\012\006\015\002Z\003\193\002`\002X\001\242\002]\005\142\006\016\002f\001\182\002\\\004\015\001\030\002\007\0018\003>\006\014\001\214\001\026\001\182\004\205\004\018\001Z\006\031\003\231\003\230\003\232\001\214\004\022\002h\005\233\004\206\002Z\002\006\002`\004\207\002\235\003\202\006 \003?\002f\001\213\002\\\002\007\006\015\003*\001\012\006\019\002X\005A\005B\006\021\006\016\001\218\002\003\002\004\001\243\001\012\002\007\006y\000\225\002h\006\023\001\218\006\232\002Z\005J\002`\001\219\006\t\005K\002\003\002\004\002f\003;\002\\\003>\006\024\001\219\000\184\006j\002\006\003\201\006 \001\012\002G\006\n\002\003\002\004\006\012\001.\002\007\006\019\002H\002h\002Z\006\021\001\021\006\r\006#\005\202\004\185\0007\002[\005\023\002\\\002V\006\023\001\021\003>\002Z\002\233\002`\001\007\002\233\000\233\001\b\002\233\002f\003A\002\\\000\184\006\024\001\030\000\184\0018\005\205\006\014\001I\001\229\001\240\005\024\005X\005\025\006w\001\021\000\253\001\000\001\007\002h\001\n\001\b\002\006\002Z\001\007\005\198\001\006\001\b\005\198\006\132\005\193\002[\002\007\002\\\003\197\006\015\000\221\001\242\001[\002X\005\246\001 \005\026\006\016\004\137\001\n\001\182\002\234\004 \002\007\004?\001\n\001\012\005\200\001\214\002\006\005\200\001\026\000\226\006&\003A\000\134\005:\005.\001\199\002\007\005\242\005\201\005:\005\027\005\201\002\233\005\203\002\233\006 \005\203\005\207\004\198\005\028\005\204\005\029\005\244\001\026\006\019\002Z\001\012\000\229\006\021\001\026\001\243\001\218\004\198\002[\003@\002\\\005Y\006\147\000\189\006\023\006\209\002\004\002Z\006\161\002`\001\015\001\219\005\245\004\198\001\213\002f\001\012\002\\\001\151\006\024\001\241\002\233\001\012\002Z\005\031\000\189\001+\001\012\005!\005+\003\252\002[\004\"\002\\\004\205\001.\002h\001U\002\024\005U\001W\001X\001\021\000\234\0044\004\206\005Z\0012\004\205\004\212\001\182\001\007\004s\000\189\005V\005A\005B\002\233\001\214\004\206\001.\005A\005B\004\238\001T\0017\001.\001\021\001\030\001T\0018\005C\005S\001\021\004\170\004\201\005K\005C\005S\003s\002\228\002\229\005K\001U\001e\001F\001W\001X\001U\001e\005\153\001W\001X\001\030\001\218\0018\005\023\0015\001T\001\030\001\182\0018\004{\006\210\000\189\001n\003i\0013\001\214\001\219\006n\004\005\004&\002\003\002\004\001]\002\233\001U\001e\004*\001W\001X\000\184\005\024\006\187\005\025\001f\002G\001g\002#\001M\001f\003\217\001g\002#\002H\003v\003{\0017\006[\006M\006J\004R\001\012\001\218\002\233\005\198\002\233\002V\006\\\005\157\001n\001\007\0007\005\026\001\b\001n\003\201\000\189\001\219\001f\001]\001g\002#\003\201\003l\001]\001p\000\189\004'\003l\0053\003\230\003\232\005\200\001q\001\141\001[\001\182\001\n\004\129\005\027\002\003\002\004\004/\001n\001\214\001d\005\201\003\220\005\028\000\189\005\029\005\203\001\021\001]\002G\005\214\004+\003l\004\214\002X\006W\006q\002H\006\164\001\007\005Y\001\007\005\001\006\195\002\007\0007\001p\005\023\002\233\001\026\002V\001p\004R\003Y\001q\001\218\001[\002\003\002\004\001q\001L\001[\003\201\005\031\006\189\002\233\001\n\005!\005+\002]\001\219\002G\002\003\002\004\005\024\006\169\005\025\001\012\005U\002H\001p\000\189\001\138\006\197\001\007\001\007\002G\001\b\001q\0068\001[\001\229\002V\005V\002H\003\217\002Z\004\208\002`\001\229\004\003\0040\001c\002X\002f\005\026\002\\\002V\002\233\002\233\003\217\001\n\006c\002\007\001m\001\182\004\024\004\136\004J\001\242\001\129\001.\001\145\001\214\004>\002h\001\007\001\242\001\021\001\b\001\012\001\012\005\027\001\012\005G\003\230\003\232\001\157\002]\001\168\002\233\005\028\004:\005\029\001\162\002X\003\254\003\247\001\026\005O\003\230\003\232\000\184\001\n\001\030\002\007\003\227\003\183\005Y\001\218\002X\004\231\004\239\004\180\001\167\002Z\001\175\002`\001\170\001T\002\007\001\243\001\220\002f\001\219\002\\\001\012\001\012\005\156\001\243\002]\005\031\001\021\001T\001\021\005!\005+\001\192\001U\001e\001\026\001W\001X\006\175\002h\002]\005U\000\184\001\148\006\153\000\189\005\180\001U\001e\001\194\001W\001X\002Z\001\030\003\133\003\235\005V\001\132\001\007\002\233\002f\001\b\002\\\001\012\001\"\006\127\005\198\002Z\006\131\002`\004\208\004\208\001\021\001\021\000\189\002f\001f\002\\\001g\001\135\003\217\002h\001\179\001\007\001#\001\n\001\b\001\254\001\201\001\"\001f\001A\001g\001\135\005\200\001\203\002h\001\007\001\030\003\241\001\b\001n\0017\001\"\002\001\001\206\002\015\001.\005\201\001#\001\n\001]\004W\005\203\001\021\001n\001?\005\232\004\185\006\140\003\230\003\232\001\026\001#\001\n\001]\001\007\002\003\002\004\001\b\001$\001\210\001\"\006\156\006\157\001\217\003\176\003\172\002\030\001(\001\030\002G\0018\000\189\002\003\002\004\000\184\001\026\000\189\002H\001\012\001\253\001#\001\n\005K\003\253\0064\002\000\002G\001=\003\162\001\026\002V\001p\001(\000\189\002H\000\189\001\229\002\014\005\198\001q\003\182\001[\002!\001\012\002\029\001p\001(\002V\002'\002 \005\242\002\233\001\182\001q\006C\001[\002<\001\012\001\026\001T\001\214\006?\001.\002&\001\242\005\244\005\200\000\189\002A\001\021\002\003\002\004\002\152\0016\002\233\001(\0022\002/\001U\001e\005\201\001W\001X\002X\002G\005\203\001\012\001.\001\137\005\251\005\245\002\233\002H\002\007\001\021\001\030\001\218\0018\0016\006\167\002X\001.\003\179\000\189\004Z\002V\003\184\0027\001\021\000\189\002\007\001\219\0016\0026\003\190\002;\001\243\000\189\002]\002@\001\030\001f\0018\001g\001\135\003\205\003\224\004b\002\236\000\189\001.\003\226\002e\000\189\001\030\002]\0018\001\021\002\003\002\004\002\156\0016\002\233\002\191\004f\002Z\001n\002`\002\198\003\244\002\227\003\248\002G\002f\004\023\002\\\001]\002\226\002X\003N\002H\002\233\002Z\001\030\002`\0018\003\165\000\189\002\007\003V\002f\004\029\002\\\002V\002h\000\189\002\003\002\004\004$\002\003\002\004\004-\004=\001T\003\142\004B\000\189\000\189\006\156\006\157\002G\002h\000\189\002]\004M\004m\004V\004Y\002H\002\003\002\004\002\005\001U\001e\003r\001W\001X\004`\001p\005K\000\189\002V\000\189\002G\004q\000\189\001q\003\152\001[\003\174\002Z\002H\003\133\003\189\004d\004i\002X\003m\002f\003\204\002\\\004~\000\189\004\135\002V\003\213\002\007\002\003\002\004\000\189\002\233\004\140\000\189\000\189\003\243\001f\000\189\001g\002#\002h\004\145\002G\004\155\004\161\004\172\000\189\001T\000\189\000\189\002H\003\250\002]\004\187\004\209\002X\003b\002\233\002\006\000\189\004#\001n\004\028\002V\004\030\002\007\001U\001e\002\007\001W\001X\001]\002\003\002\004\004!\003h\000\189\000\189\002X\002Z\004\192\002`\0042\000\189\004u\000\189\002G\002f\002\007\002\\\002]\004\216\002\233\000\189\002H\0041\002\003\002\004\004\233\004<\003S\004\243\000\189\005\014\000\189\000\189\000\189\002V\002h\001f\004\184\001g\002+\002]\000\189\000\189\002X\002Z\002B\002`\002Z\002\003\002\004\001p\002\233\002f\002\007\002\\\002[\004A\002\\\001q\005#\001[\001n\002G\005-\002\233\002\233\004C\002Z\000\189\002`\002H\001]\004\221\002h\002\233\002f\003K\002\\\002]\000\189\004I\002\003\002\004\002V\002\003\002\004\000\189\002X\002\233\000\189\002\233\000\189\002\233\0059\002.\002G\002h\002\007\002G\002\233\005M\005]\002\233\002H\004\226\002Z\002H\002`\004H\002S\004L\002\006\002_\002f\005c\002\\\002V\005\012\005\020\002V\000\189\002\007\002]\001p\000\189\002\003\002\004\005 \002\003\002\004\005g\001q\005\131\001[\002h\005\171\002X\004N\005\231\002G\005\176\005(\002G\005?\005\215\005p\002\007\002H\005\181\002Z\002H\002`\005\147\002n\000\189\005\173\002m\002f\004X\002\\\002V\000\189\000\189\002V\004c\004_\002\233\002\153\002\233\002X\004a\002]\002X\002Z\005\211\000\189\005\187\004e\002h\002\007\004h\002[\002\007\002\\\005\195\004l\002\207\001e\005\236\001W\001X\000\189\006\001\000\189\002\233\001T\000\189\002\233\002Z\000\189\002`\000\189\002\233\002\170\002]\000\189\002f\002]\002\\\000\189\006>\002\173\004p\002X\001U\002\174\002X\001W\001X\005\184\002\233\005\218\004\132\002\007\002\003\002\004\002\007\002h\002\212\002\228\002\229\002Z\004\131\002`\002Z\000\189\002`\000\189\002G\002f\004\134\002\\\002f\002\233\002\\\000\189\002H\005\230\002]\000\189\005\234\002]\002\161\000\189\001n\005\238\002\233\002\233\002\233\002V\002h\004\139\004\141\002h\001]\002\003\002\004\006X\004\242\006d\006r\000\189\002\233\005\243\002\233\002Z\006t\002`\002Z\002G\002`\002\233\001\\\002f\004\144\002\\\002f\002H\002\\\004\147\002\232\004\151\001]\002\172\004\159\002\233\005\255\002\233\001T\004\166\002V\002\003\002\004\004\177\002h\002\233\002\170\002h\002\233\006\006\006\020\006\027\002X\004\193\002\173\002G\001p\001U\002\174\002\175\001W\001X\002\007\002H\001q\006$\001[\006i\000\189\002\195\000\189\000\189\004\210\004\241\006\149\004\234\002V\000\189\004\235\002\177\004\240\004\244\002\003\002\004\001p\002\003\002\004\002]\006\163\002\153\006\219\004\245\001\139\002X\001[\005\022\002G\005\015\006\230\002G\005\016\006\235\005\021\002\007\002H\005*\005&\002H\002\207\001e\002\202\001W\001X\002\205\002Z\005'\002`\002V\002\003\002\004\002V\005)\002f\005T\002\\\001\\\0057\0058\002]\002X\005<\005>\002G\005@\005L\001]\005\\\005^\005_\002\007\002H\005d\005h\002h\005l\005~\002\211\005\133\005\137\005\161\002\212\002\228\002\229\002V\005\182\002Z\005\188\002`\005\206\005\212\005\216\006\b\002\175\002f\002]\002\\\006\002\006\003\006\007\006\022\002X\006=\006H\002X\006S\006U\001n\006g\006h\006l\002\007\006\148\002\176\002\007\002h\006\152\001]\001p\006\162\002\003\002\004\002Z\006\166\002`\006\204\001\139\000\000\001[\000\000\002f\000\000\002\\\000\000\002G\000\000\002]\002X\000\000\002]\000\000\000\000\002H\003z\000\000\000\000\000\000\002\007\002\214\000\000\000\000\002h\000\000\002\003\002\004\002V\002\003\002\004\000\000\000\000\000\000\000\000\000\000\002Z\000\000\002`\002Z\002G\002`\001p\002G\002f\002]\002\\\002f\002H\002\\\001q\002H\001[\000\000\002\239\000\000\000\000\003\028\000\000\000\000\000\000\002V\002\003\002\004\002V\002h\000\000\000\000\002h\000\000\000\000\000\000\002Z\000\000\002`\000\000\002G\000\000\000\000\000\000\002f\002X\002\\\000\000\002H\000\000\000\000\000\000\000\000\000\000\003!\002\007\000\000\000\000\000\000\000\000\000\000\002V\000\000\000\000\000\000\002h\000\000\000\000\002\003\002\004\000\000\000\000\000\000\002\003\002\004\000\000\000\000\000\000\002X\000\000\002]\002X\002G\000\000\000\000\000\000\000\000\002G\002\007\000\000\002H\002\007\000\000\000\000\000\000\002H\003O\000\000\000\000\000\000\000\000\003Q\000\000\002V\002\003\002\004\000\000\002Z\002V\002`\000\000\000\000\000\000\002]\002X\002f\002]\002\\\002G\002\003\002\004\000\000\000\000\000\000\002\007\000\000\002H\000\000\000\000\000\000\000\000\000\000\003[\002G\000\000\000\000\002h\000\000\000\000\002V\002Z\002H\002`\002Z\000\000\002`\000\000\003d\002f\002]\002\\\002f\000\000\002\\\002V\000\000\002X\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002\007\000\000\000\000\002h\000\000\002\007\002h\000\000\000\000\000\000\002Z\000\000\002`\000\000\000\000\000\000\000\000\000\000\002f\000\000\002\\\002\003\002\004\000\000\000\000\002]\002X\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\002G\002\007\000\000\000\000\002h\000\000\002X\000\000\002H\000\000\000\000\000\000\000\000\000\000\003g\001T\002\007\002Z\000\000\002`\000\000\002V\002Z\000\000\002`\002f\002]\002\\\000\000\000\000\002f\000\000\002\\\000\000\001U\001e\000\000\001W\001X\000\000\000\000\002]\000\000\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\002h\000\000\002Z\000\000\002`\000\000\000\000\000\000\002\003\002\004\002f\000\000\002\\\000\000\000\000\000\000\000\000\002Z\000\000\002`\002\003\002\004\002G\002X\000\000\002f\001f\002\\\001g\002#\002H\002h\000\000\002\007\002G\000\000\003u\000\000\002\003\002\004\000\000\001\007\002H\002V\001\b\000\000\002h\000\000\003x\000\000\000\000\001n\002G\000\000\000\000\002V\000\000\000\000\002]\000\000\002H\001]\000\000\000\000\000\000\003k\002\003\002\004\001\n\000\000\003\130\000\000\000\000\002V\000\000\000\000\001,\002\003\002\004\000\000\002G\000\000\000\000\000\000\000\000\002Z\000\000\002`\002H\000\000\000\000\002G\000\000\002f\000\000\002\\\002X\000\000\003\135\002H\000\000\002V\000\000\000\000\000\000\001\026\002\007\000\000\002X\003\138\000\000\000\000\002V\001p\002h\000\000\002\003\002\004\002\007\000\000\000\000\001q\000\000\001[\000\000\000\000\002X\002\003\002\004\000\000\002G\002]\000\000\001\012\000\000\000\000\002\007\000\000\002H\000\000\000\000\002G\000\000\002]\003\187\000\000\000\000\000\000\000\000\002H\000\000\002V\000\000\000\000\002X\003\200\000\000\000\000\002Z\000\000\002`\002]\002V\000\000\002\007\002X\002f\000\000\002\\\000\000\002Z\000\000\002`\000\000\000\000\002\007\000\000\001.\002f\000\000\002\\\000\000\000\000\000\000\001\021\000\000\000\000\002h\002Z\002]\003\133\000\000\000\000\000\000\000\000\000\000\002f\000\000\002\\\002h\002]\000\000\000\000\000\000\002X\000\000\002\003\002\004\000\000\000\000\001\030\000\000\0014\000\000\002\007\002X\002Z\002h\003\133\000\000\002G\000\000\000\000\000\000\002f\002\007\002\\\002Z\002H\003\133\000\000\000\000\000\000\000\000\003\246\002f\000\000\002\\\002\153\002]\000\000\002V\000\000\000\000\000\000\002h\001\007\000\000\000\000\001\b\002]\000\000\0019\002\003\002\004\000\000\002h\002\207\001e\000\000\001W\001X\000\000\000\000\000\000\000\000\002Z\002G\002`\000\000\000\000\000\000\001;\001\n\002f\002H\002\\\002Z\004\196\002`\000\000\0048\000\000\002\003\002\004\002f\000\000\002\\\002V\000\000\000\000\000\000\000\000\000\000\002X\002h\000\000\002G\000\000\002\212\002\228\002\229\000\000\000\000\002\007\002H\002h\000\000\000\000\000\000\001\026\005k\000\000\000\000\002\003\002\004\000\000\000\000\002V\000\000\000\000\002\003\002\004\000\000\000\000\001n\000\000\001(\002G\002]\000\000\000\000\002\003\002\004\000\000\001]\002H\000\000\001\012\000\000\000\000\002X\005n\002D\000\000\000\000\002G\000\000\000\000\002V\000\000\002\007\000\000\000\000\002H\000\000\002Z\000\000\002`\000\000\005}\003\251\000\000\000\000\002f\000\000\002\\\002V\000\000\000\000\000\000\002X\002\003\002\004\000\000\000\000\002]\002\003\002\004\000\000\000\000\002\007\001.\000\000\000\000\002h\002G\001p\000\000\001\021\000\000\000\000\000\000\004\253\002H\001q\000\000\001[\000\000\002N\005\128\000\000\002X\002Z\000\000\002`\002]\002V\000\000\002\006\000\000\002f\002\007\002\\\000\000\001\030\000\000\0018\000\000\002\007\002X\000\000\002\003\002\004\000\000\000\000\000\000\000\000\000\000\000\000\002\007\000\000\002h\002Z\000\000\002`\002G\002]\000\000\000\000\000\000\002f\000\000\002\\\002H\002\003\002\004\000\000\000\000\001\007\005\141\000\000\001\b\000\000\000\000\002]\000\000\002V\000\000\002G\002X\000\000\002h\000\000\002Z\002\006\002`\002H\000\000\000\000\002\007\002Z\002f\005\144\002\\\002\007\001\n\002\003\002\004\002[\002V\002\\\002Z\000\000\002`\000\000\004\180\000\000\000\000\000\000\002f\002G\002\\\002h\000\000\002]\002\153\000\000\000\000\002H\000\000\005\166\000\000\000\000\000\000\005\165\000\000\000\000\000\000\000\000\002X\002h\002V\001\026\000\000\002\207\001e\000\000\001W\001X\002\007\000\000\002Z\000\000\002`\002\003\002\004\002Z\002\003\002\004\002f\000\000\002\\\002X\000\000\002[\000\000\002\\\000\000\002G\000\000\001\012\002G\002\007\000\000\002]\000\000\002H\000\000\000\000\002H\002h\000\000\005\168\000\000\000\000\005\172\002\212\002\228\002\229\002V\000\000\000\000\002V\000\000\002X\000\000\000\000\002]\002\003\002\004\000\000\002Z\000\000\002`\002\007\000\000\000\000\000\000\000\000\002f\000\000\002\\\001n\000\000\001.\000\000\000\000\000\000\000\000\000\000\003\146\001\021\001]\000\000\002Z\004\185\002`\003\155\000\000\002]\002h\000\000\002f\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002\153\000\000\002X\002\003\002\004\002X\000\000\001\030\005\183\0018\003\168\000\000\002\007\002h\000\000\002\007\002Z\002G\002`\002\207\001e\000\000\001W\001X\002f\002H\002\\\000\000\000\000\000\000\000\000\006\179\000\000\000\000\001p\000\000\000\000\002]\002V\000\000\002]\000\000\001q\000\000\001[\002h\002\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\003\002\004\003\159\000\000\002\003\002\004\000\000\002\212\002\228\002\229\002Z\000\000\002`\002Z\002G\002`\000\000\000\000\002f\000\000\002\\\002f\002H\002\\\000\000\000\000\002Y\000\000\006\181\000\000\000\000\003\149\006\t\001n\000\000\002V\000\000\002X\000\000\002h\000\000\000\000\002h\001]\000\000\000\000\006\225\002\007\001T\006\226\000\000\000\000\006\012\000\000\002Z\000\000\000\000\000\000\000\000\000\000\000\000\006\r\002[\000\000\002\\\000\000\000\000\001U\001e\005\217\001W\001X\002]\000\000\000\000\000\000\000\000\000\000\000\000\001\007\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\000\002X\000\000\006\014\000\000\002\006\000\000\000\000\001p\000\000\000\000\002\007\002Z\000\000\002`\002\007\001q\000\000\001[\001\n\002f\000\000\002\\\001f\000\000\001g\006\199\006\201\000\000\002\196\006\t\006\015\000\000\000\000\000\000\006\t\002]\000\000\000\000\006\016\006\t\002h\000\000\000\000\006\225\000\000\000\000\006\226\001n\006\225\006\012\006\228\006\226\000\000\006\225\006\012\001\026\006\226\001]\006\r\006\012\000\000\000\000\002Z\006\r\002`\000\000\002Z\000\000\006\r\006\018\002f\000\000\002\\\000\000\002[\000\000\002\\\000\000\006\019\001T\000\000\000\000\006\021\001\012\000\000\000\000\000\000\006\014\000\000\000\000\000\000\002h\006\014\006\023\000\000\000\000\000\000\006\014\001U\001e\000\000\001W\001X\000\000\002\003\002\004\000\000\000\000\006\024\001p\000\000\000\000\000\000\000\000\000\000\006\015\000\000\001q\002G\001[\006\015\000\000\000\000\006\016\000\000\006\015\002H\001.\006\016\000\000\000\000\000\000\000\000\006\016\001\021\006\227\002\003\002\004\002\167\002V\006\231\001f\000\000\001g\006.\006\236\000\000\002\003\002\004\000\000\002G\000\000\000\000\000\000\006\018\000\000\000\000\000\000\002H\006\018\001\030\002G\0018\006\019\006\018\000\000\001n\006\021\006\019\002H\000\000\002V\006\021\006\019\000\000\000\000\001]\006\021\006\023\000\000\000\000\000\000\002V\006\023\001\007\001T\000\000\001\b\006\023\000\000\0019\000\000\002X\006\024\000\000\000\000\000\000\000\000\006\024\000\000\000\000\000\000\002\007\006\024\001U\001e\000\000\001W\001X\000\000\001;\001\n\000\000\000\000\001\007\000\000\000\000\001\b\000\000\000\000\001\"\000\000\006\t\000\000\002X\000\000\001\007\002]\001p\001\b\000\000\000\000\000\000\000\000\002\007\002X\001q\000\000\001[\006\n\001'\001\n\006\012\000\000\000\000\002\007\000\000\001f\001\026\001g\001\140\006\r\000\000\001\n\002Z\000\000\004\006\000\000\000\000\002]\000\000\000\000\002f\003\220\002\\\001(\001\007\000\000\000\000\001\b\002]\000\000\001n\000\000\000\000\000\000\001\012\003\223\001\026\000\000\006\014\001T\001]\002h\000\000\000\000\002Z\000\000\004\002\000\000\001\026\000\000\000\000\001\n\002f\001(\002\\\002Z\004\196\003\171\001U\001e\001T\001W\001X\002f\001\012\002\\\006\015\000\000\000\000\000\000\000\000\000\000\000\000\002h\006\016\001T\001\012\000\000\001.\001U\001e\000\000\001W\001X\002h\001\021\000\000\001T\001\026\0016\006\017\000\000\001p\000\000\001U\001e\000\000\001W\001X\000\000\001q\001f\001[\001g\001v\006\018\001U\001e\001.\001W\001X\001\030\000\000\0018\006\019\001\021\001\012\000\000\006\021\0016\001.\000\000\001f\000\000\001g\001s\001n\001\021\000\000\006\023\000\000\000\000\000\000\000\000\000\000\000\000\001]\001f\000\000\001g\001i\001\030\000\000\0018\006\024\000\000\001T\001n\000\000\001f\000\000\001g\001l\001\030\000\000\003\227\000\000\001]\001T\000\000\001.\000\000\001n\001T\000\000\001U\001e\001\021\001W\001X\000\000\004\204\001]\000\000\001n\000\000\000\000\001U\001e\000\000\001W\001X\001U\001e\001]\001W\001X\000\000\001p\000\000\000\000\000\000\000\000\001\030\000\000\0018\001q\000\000\001[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001f\001p\001g\001o\000\000\000\000\000\000\000\000\000\000\001q\000\000\001[\001f\000\000\001g\001r\001p\001f\000\000\001g\001{\001T\000\000\000\000\001q\001n\001[\000\000\001p\000\000\000\000\000\000\002\003\002\004\000\000\001]\001q\001n\001[\000\000\001U\001e\001n\001W\001X\000\000\002G\001]\000\000\000\000\000\000\001T\001]\000\000\002H\000\000\000\000\001T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002V\002\003\002\004\001U\001e\000\000\001W\001X\000\000\001U\001e\000\000\001W\001X\000\000\002G\001f\000\000\001g\001~\001p\000\000\000\000\002H\000\000\000\000\000\000\000\000\001q\000\000\001[\000\000\001p\000\000\000\000\000\000\002V\001p\000\000\000\000\001q\001n\001[\000\000\000\000\001q\001f\001[\001g\002=\000\000\001]\001f\002X\001g\002\217\000\000\000\000\002\003\002\004\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\000\000\002\003\002\004\001n\002G\000\000\000\000\000\000\000\000\001n\000\000\000\000\002H\001]\000\000\002G\002\003\002\004\000\000\001]\002]\002X\000\000\002H\000\000\002V\000\000\000\000\000\000\000\000\002G\002\007\002\003\002\004\000\000\001p\002V\000\000\002H\002\003\002\004\000\000\000\000\001q\000\000\001[\002G\002Z\000\000\003C\000\000\002V\000\000\002G\002H\002f\002]\002\\\000\000\000\000\000\000\002H\000\000\000\000\000\000\001p\000\000\002V\000\000\000\000\000\000\001p\000\000\001q\002V\001[\002h\000\000\002X\001q\000\000\001[\000\000\002Z\000\000\003B\000\000\000\000\002\007\002X\000\000\002f\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002h\002]\002\007\000\000\000\000\000\000\000\000\000\000\002X\002\003\002\004\000\000\002]\002\003\002\004\002X\000\000\000\000\002\007\000\000\002\003\002\004\000\000\002G\000\000\002\007\000\000\002]\002Z\000\000\002\237\002H\000\000\000\000\002G\002g\002f\000\000\002\\\002Z\000\000\002b\002H\002]\002V\000\000\000\000\002f\000\000\002\\\002]\002\003\002\004\000\000\002Z\002V\002d\002h\000\000\000\000\002\003\002\004\002f\000\000\002\\\002G\000\000\000\000\002h\000\000\002Z\000\000\002i\002H\002G\000\000\000\000\002Z\002f\002p\002\\\000\000\002H\002h\000\000\002f\002V\002\\\000\000\000\000\000\000\002\003\002\004\000\000\000\000\002V\000\000\002X\000\000\002h\000\000\002\006\002\003\002\004\000\000\002G\002h\002\007\002X\002\003\002\004\002\007\000\000\002H\000\000\000\000\002G\000\000\002\007\000\000\000\000\000\000\000\000\002G\002H\000\000\002V\000\000\000\000\000\000\000\000\002H\002]\002\003\002\004\000\000\000\000\002V\000\000\002X\002\003\002\004\000\000\002]\002V\000\000\000\000\002G\002X\002\007\000\000\000\000\000\000\000\000\002G\002H\000\000\000\000\002\007\002Z\000\000\002r\002H\002Z\000\000\000\000\000\000\002f\002V\002\\\002Z\002[\002t\002\\\002]\002V\000\000\000\000\002f\002X\002\\\000\000\000\000\002]\002\003\002\004\000\000\000\000\002h\002\007\002X\002\003\002\004\000\000\000\000\000\000\000\000\002X\002G\002h\002\007\002Z\000\000\002v\000\000\002G\002H\002\007\000\000\002f\002Z\002\\\002x\002H\002]\002\003\002\004\000\000\002f\002V\002\\\002X\002\003\002\004\000\000\002]\002V\000\000\002X\002G\002h\002\007\002]\002\003\002\004\000\000\002G\002H\002\007\002h\000\000\002Z\000\000\002z\002H\000\000\000\000\002G\000\000\002f\002V\002\\\002Z\000\000\002|\002H\002]\002V\000\000\002Z\002f\002~\002\\\002]\002\003\002\004\000\000\002f\002V\002\\\002h\000\000\002X\002\003\002\004\000\000\000\000\000\000\002G\002X\000\000\002h\002\007\002Z\000\000\002\128\002H\002G\002h\002\007\002Z\002f\002\130\002\\\000\000\002H\000\000\000\000\002f\002V\002\\\002\003\002\004\002X\002\003\002\004\000\000\002]\002V\000\000\002X\000\000\002h\002\007\002]\002\003\002\004\000\000\002G\002h\002\007\002X\000\000\003\146\000\000\000\000\002H\000\000\000\000\002G\003\155\002\007\000\000\000\000\002Z\000\000\002\132\002H\002]\002V\000\000\002Z\002f\002\134\002\\\002]\002\003\002\004\000\000\002f\002V\002\\\002X\003\156\000\000\000\000\002]\000\000\000\000\000\000\002G\002X\002\007\002h\000\000\002Z\000\000\002\136\002H\000\000\002h\002\007\002Z\002f\002\138\002\\\000\000\000\000\000\000\000\000\002f\002V\002\\\002Z\000\000\002\140\000\000\002]\000\000\002\006\000\000\002f\002X\002\\\002h\000\000\002]\000\000\000\000\003\159\000\000\002h\002\007\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002h\002\007\002Z\000\000\002\142\000\000\000\000\000\000\000\000\000\000\002f\002Z\002\\\002\144\001T\002]\003\149\000\000\000\000\002f\000\000\002\\\002X\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\002h\002\007\001U\001e\000\000\001W\001X\000\000\002Z\002h\000\000\002Z\000\000\002\146\000\000\001T\002[\000\000\002\\\002f\000\000\002\\\002Z\002\203\002\148\000\000\002]\002\003\002\004\000\000\002f\002\206\002\\\000\000\001U\002\174\000\000\001W\001X\000\000\002h\002G\000\000\000\000\000\000\001f\001T\001g\002\220\002H\000\000\002h\000\000\002Z\000\000\002\150\000\000\002\003\002\004\000\000\000\000\002f\002V\002\\\001T\001U\001e\000\000\001W\001X\001n\002G\000\000\000\000\000\000\000\000\000\000\000\000\001T\002H\001]\000\000\002h\001U\001e\000\000\001W\001X\000\000\000\000\000\000\000\000\002V\000\000\004\001\002\003\002\004\001U\002\174\000\000\001W\001X\001\\\000\000\000\000\000\000\000\000\000\000\001f\002G\001g\002\223\001]\000\000\000\000\002X\000\000\002H\000\000\000\000\000\000\000\000\002\003\002\004\000\000\002\007\001f\000\000\001g\002\231\002V\000\000\001p\001n\002\003\002\004\000\000\000\000\000\000\002\175\001q\000\000\001[\001]\003\006\002X\002\003\002\004\002G\000\000\002]\001n\000\000\000\000\000\000\002\007\002H\000\000\000\000\000\000\002G\001]\002\003\002\004\001p\001\\\000\000\000\000\002H\002V\000\000\000\000\001\139\000\000\001[\001]\002G\002Z\000\000\002\243\002]\002V\000\000\002X\002H\002f\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002\007\000\000\001p\000\000\002V\000\000\000\000\000\000\001\007\002\175\001q\004\254\001[\002h\002Z\000\000\002\249\002\006\002\003\002\004\001p\000\000\002f\000\000\002\\\002]\000\000\002\007\001q\002X\001[\000\000\002G\000\000\001p\001\n\002\003\002\004\000\000\002\007\002H\002X\001\139\002h\001[\000\000\001T\000\000\000\000\000\000\002G\002\007\002Z\002V\002\253\001T\000\000\002X\002H\000\000\002f\000\000\002\\\000\000\002]\001U\001V\002\007\001W\001X\000\000\002V\005\000\000\000\001U\002\174\002]\001W\001X\002Z\000\000\002h\000\000\000\000\000\000\000\000\000\000\002[\000\000\002\\\000\000\002Z\002]\003\001\000\000\002\003\002\004\000\000\000\000\002f\005\003\002\\\000\000\002Z\000\000\003\t\002X\000\000\000\000\002G\000\000\002f\000\000\002\\\000\000\000\000\002\007\002H\000\000\002Z\002h\003\r\000\000\000\000\002X\002\003\002\004\002f\000\000\002\\\002V\000\000\002h\001\\\002\007\000\000\002\003\002\004\000\000\002G\000\000\002]\001\\\001]\000\000\000\000\000\000\002H\002h\000\000\002G\005\006\001]\000\000\000\000\000\000\000\000\000\000\002H\002]\002V\000\000\004\206\000\000\005\011\000\000\005\b\000\000\002Z\000\000\003\015\002V\000\000\000\000\000\000\000\000\002f\001\030\002\\\005\252\000\000\000\000\000\000\002X\002\003\002\004\002Z\000\000\003\019\000\000\000\000\000\000\000\000\002\007\002f\001p\002\\\002h\002G\000\000\000\000\000\000\000\000\001\139\001p\001[\002H\002\003\002\004\000\000\000\000\000\000\001\139\002X\001[\002h\000\000\000\000\002]\002V\000\000\002G\000\000\002\007\002X\005\254\000\000\000\000\000\000\002H\002\003\002\004\000\000\000\000\002\007\002\003\002\004\000\000\000\000\000\000\000\000\000\000\002V\000\000\002G\002Z\000\000\003\021\002]\002G\000\000\000\000\002H\002f\000\000\002\\\000\000\002H\000\000\002]\000\000\000\000\000\000\000\000\000\000\002V\000\000\000\000\000\000\000\000\002V\000\000\002X\000\000\002h\002Z\000\000\003\025\002\003\002\004\000\000\000\000\002\007\002f\000\000\002\\\002Z\000\000\003\031\000\000\000\000\000\000\002G\000\000\002f\002X\002\\\001T\000\000\000\000\002H\000\000\000\000\000\000\002h\002\007\000\000\002]\000\000\000\000\002\003\002\004\000\000\002V\000\000\002h\001U\002\159\002X\001W\001X\000\000\000\000\002X\002G\002\003\002\004\000\000\002\007\000\000\002]\000\000\002H\002\007\002Z\000\000\003$\000\000\000\000\002G\000\000\000\000\002f\000\000\002\\\002V\000\000\002H\000\000\000\000\000\000\000\000\000\000\002]\000\000\000\000\000\000\002Z\002]\003&\002V\002\003\002\004\002h\000\000\002f\002X\002\\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002G\002\007\000\000\000\000\000\000\002Z\000\000\003)\002H\001\\\002Z\002h\003-\002f\000\000\002\\\000\000\000\000\002f\001]\002\\\002V\000\000\002X\000\000\000\000\002]\002\003\002\004\000\000\002\003\002\004\000\000\002\007\002h\000\000\000\000\000\000\002X\002h\000\000\002G\000\000\000\000\002G\002\003\002\004\000\000\002\007\002H\000\000\000\000\002H\002Z\000\000\0030\000\000\000\000\002]\002G\000\000\002f\002V\002\\\000\000\002V\000\000\002H\000\000\002\003\002\004\001p\000\000\002]\002X\000\000\002\003\002\004\000\000\001\139\002V\001[\002h\002G\002\007\002Z\000\000\0032\000\000\000\000\002G\002H\000\000\002f\000\000\002\\\000\000\001T\002H\000\000\002Z\000\000\0035\000\000\002V\000\000\000\000\000\000\002f\002]\002\\\002V\002\003\002\004\002h\002X\001U\001e\002X\001W\001X\000\000\000\000\000\000\000\000\002\007\002G\000\000\002\007\002h\000\000\000\000\000\000\002X\002H\000\000\002Z\000\000\0037\000\000\000\000\000\000\000\000\002\007\002f\000\000\002\\\002V\000\000\000\000\002]\001\007\000\000\002]\001\b\000\000\000\000\002X\000\000\001f\000\000\001g\0046\000\000\002X\002h\000\000\002\007\002]\000\000\000\000\000\000\000\000\000\000\002\007\005\023\000\000\002Z\001\n\003:\002Z\000\000\003=\000\000\001n\002f\000\000\002\\\002f\005\023\002\\\000\000\002]\000\000\001]\002Z\000\000\003F\000\000\002]\002X\000\000\005\024\002f\005\025\002\\\002h\000\000\000\000\002h\002\007\000\000\000\000\000\000\000\000\001\026\005\024\000\000\005\025\002Z\000\000\003I\006\t\000\000\002h\000\000\002Z\002f\003o\002\\\000\000\000\000\006\t\005\026\002f\002]\002\\\000\000\000\000\006\n\000\000\000\000\006\012\001\012\000\000\000\000\001p\005\026\002h\006\n\000\000\006\r\006\012\000\000\001q\002h\001[\000\000\000\000\000\000\005\027\006\r\002Z\000\000\003q\000\000\000\000\000\000\000\000\005\028\002f\005\029\002\\\000\000\005\027\006\t\000\000\000\000\000\000\000\000\006\014\000\000\000\000\005\028\000\000\005\029\005W\001.\000\000\000\000\006\014\002h\006\216\000\000\001\021\006\012\000\000\000\000\004\217\000\000\005\030\004\220\000\000\000\000\006\r\000\000\000\000\000\000\006\015\005\031\000\000\000\000\000\000\005!\005+\000\000\006\016\000\000\006\015\000\000\001\030\001T\0018\005\031\005U\000\000\006\016\005!\005+\000\000\000\000\000\000\006\028\006\014\000\000\000\000\000\000\000\000\005U\005V\001U\002\174\006%\001W\001X\001T\000\000\006\018\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\006\019\006\018\000\000\000\000\006\021\006\015\000\000\000\000\001U\002\174\006\019\001W\001X\006\016\006\021\006\023\000\000\000\000\000\000\001T\000\000\000\000\000\000\000\000\000\000\006\023\006\217\000\000\001T\000\000\006\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001U\002\174\006\024\001W\001X\000\000\006\018\000\000\000\000\001U\002\174\000\000\001W\001X\001\\\006\019\000\000\000\000\000\000\006\021\001T\000\000\000\000\000\000\001]\000\000\000\000\000\000\000\000\000\000\006\023\000\000\000\000\000\000\001T\000\000\005\145\000\000\001\\\001U\002\174\000\000\001W\001X\000\000\006\024\000\000\000\000\001]\000\000\005\169\003\\\000\000\001U\002\174\000\000\001W\001X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\\\000\000\003_\000\000\000\000\001T\000\000\003\\\001p\001\\\001]\001T\000\000\000\000\000\000\000\000\001\139\000\000\001[\001]\000\000\000\000\000\000\000\000\001U\002\174\003^\001W\001X\000\000\001U\002\174\001p\001W\001X\001T\000\000\003\\\000\000\001\\\001\139\000\000\001[\000\000\000\000\000\000\003\\\000\000\000\000\001]\000\000\000\000\000\000\001\\\001U\002\174\003]\001W\001X\000\000\000\000\000\000\001p\001]\001T\003a\000\000\000\000\000\000\000\000\001\139\001p\001[\000\000\000\000\000\000\002\175\000\000\000\000\001\139\000\000\001[\000\000\001U\002\174\000\000\001W\001X\000\000\000\000\002\175\000\000\001\\\001\007\001T\000\000\001\b\000\000\001\\\000\000\000\000\001p\001]\000\000\000\000\000\000\000\000\000\000\001]\001\139\000\000\001[\000\000\001U\002\174\001p\001W\001X\001\007\000\000\001\n\001\b\001\\\001\139\000\000\001[\000\000\000\000\000\000\005\196\000\000\000\000\001]\000\000\000\000\005\196\001\007\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\005\191\001\\\000\000\000\000\001p\006\191\000\000\001\026\000\000\005\252\001p\001]\001\139\001\n\001[\000\000\001\007\000\000\001\139\001\b\001[\000\000\000\000\000\000\005\209\001\007\000\000\000\000\001\b\000\000\005\208\001\\\001\026\000\000\001p\001\012\000\000\000\000\005\252\000\000\000\000\001]\001\139\001\n\001[\000\000\000\000\000\000\000\000\000\000\001\026\000\000\001\n\000\000\001\007\005\253\000\000\001\b\000\000\000\000\001\012\000\000\000\000\001p\001\007\000\000\000\000\001\b\003`\000\000\000\000\001\139\000\000\001[\000\000\000\000\000\000\000\000\001\012\001.\001\026\001\n\000\000\000\000\006\005\000\000\001\021\000\000\000\000\001\026\006\192\001\n\000\000\001p\001\007\000\000\000\000\001\b\000\000\000\000\000\000\001\139\000\000\001[\001.\000\000\000\000\001\007\001\012\000\000\001\b\001\021\001\030\001\007\0018\004\204\001\b\001\012\001\026\000\000\000\000\001\n\001.\000\000\000\000\000\000\000\000\000\000\001\026\001\021\000\000\000\000\000\000\004\217\001\n\000\000\005\237\001\030\000\000\0018\001\n\000\000\000\000\000\000\000\000\000\000\001\012\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001\030\001\012\0018\001\026\001\021\000\000\001.\000\000\006\174\000\000\000\000\000\000\000\000\001\021\000\000\000\000\001\026\001H\000\000\000\000\001\007\001\007\001\026\001\b\001\b\000\000\001\007\000\000\000\000\001\b\001\030\001\012\0018\000\000\001\007\001.\000\000\001\b\000\000\001\030\001\007\0018\001\021\001\b\001\012\001.\001\156\001\n\001\n\000\000\001\012\000\000\001\021\001\n\000\000\000\000\001\196\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\000\000\001\n\001\030\000\000\0018\000\000\000\000\000\000\000\000\001.\000\000\000\000\001\030\000\000\0018\000\000\001\021\000\000\001\026\001\026\001\198\000\000\001.\000\000\001\026\000\000\000\000\000\000\001.\001\021\000\000\000\000\001\026\002\026\000\000\001\021\000\000\000\000\001\026\002-\000\000\000\000\001\030\000\000\0018\000\000\001\012\001\012\001\007\000\000\000\000\001\b\001\012\000\000\000\000\001\030\001\007\0018\000\000\001\b\001\012\001\030\000\000\0018\000\000\000\000\001\012\000\000\001\007\000\000\000\000\001\b\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\n\000\000\000\000\001\007\000\000\000\000\001\b\001.\001.\000\000\000\000\000\000\001\n\001.\001\021\001\021\000\000\000\000\002\164\002\169\001\021\001.\000\000\001\007\002\186\000\000\001\b\001.\001\021\001\026\001\n\000\000\002\193\000\000\001\021\000\000\000\000\001\026\002\200\000\000\001\030\001\030\0018\0018\000\000\000\000\001\030\000\000\0018\001\026\001\n\000\000\000\000\000\000\001\030\001\007\0018\001\012\001\b\000\000\001\030\001\007\0018\000\000\001\b\001\012\000\000\001\026\000\000\001\007\000\000\001\007\004\254\000\000\001\b\000\000\000\000\001\012\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\001\026\001\n\000\000\000\000\001\007\000\000\000\000\004\254\001\012\001\n\000\000\001\n\000\000\000\000\001.\000\000\001\007\000\000\000\000\004\254\000\000\001\021\001.\000\000\001\007\002\209\000\000\004\254\001\012\001\021\000\000\001\n\001\026\004E\001.\000\000\000\000\000\000\001\026\000\000\000\000\001\021\000\000\001\n\000\000\004\157\005\000\001\030\001\026\0018\000\000\001\n\001.\000\000\000\000\001\030\000\000\0018\000\000\001\021\001\012\000\000\001\007\004\169\000\000\001\b\001\012\001\030\005\000\0018\000\000\000\000\001.\000\000\005\003\000\000\001\012\000\000\000\000\001\021\005\000\000\000\000\000\004\182\000\000\001\030\000\000\0018\005\000\001\n\000\000\000\000\001\007\000\000\000\000\001\b\005\003\001\007\000\000\000\000\004\254\000\000\000\000\000\000\001.\001\030\000\000\0018\005\003\000\000\001.\001\021\000\000\000\000\000\000\004\203\005\003\001\021\000\000\001\n\001.\004\219\000\000\000\000\001\n\005\006\001\026\001\021\000\000\000\000\001\007\005y\000\000\004\254\000\000\000\000\004\206\001\030\005\n\0018\005\b\000\000\000\000\001\030\000\000\0018\000\000\005\006\000\000\001\007\000\000\001\030\001\b\001\030\001\012\0018\001\026\001\n\004\206\005\006\005\t\005\000\005\b\000\000\000\000\001\007\000\000\005\006\001\b\000\000\004\206\000\000\005\007\001\030\005\b\000\000\001\n\000\000\004\206\000\000\005\019\000\000\005\b\001\007\001\012\001\030\001\b\000\000\001\007\005\003\000\000\001\b\001\n\001\030\005\000\000\000\000\000\000\000\001.\000\000\000\000\000\000\000\000\001\007\000\000\001\021\001\b\000\000\000\000\005\139\001\n\000\000\000\000\001\026\000\000\001\n\000\000\001\007\000\000\000\000\001\b\000\000\005\003\000\000\000\000\000\000\000\000\000\000\001.\001\026\001\n\001\030\000\000\0018\000\000\001\021\000\000\000\000\000\000\005\163\005\006\001\012\000\000\000\000\001\n\000\000\000\000\001\026\000\000\000\000\000\000\004\206\001\026\005\223\000\000\005\b\000\000\001\012\000\000\000\000\000\000\001\030\000\000\0018\000\000\000\000\001\030\001\026\000\000\000\000\000\000\001\007\000\000\005\006\001\b\001\012\000\000\000\000\000\000\000\000\001\012\001\026\000\000\000\000\004\206\001.\005\249\000\000\005\b\000\000\000\000\000\000\001\021\000\000\000\000\001\012\0061\000\000\001\n\001\030\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\001\021\001\012\000\000\000\000\006\134\000\000\000\000\000\000\000\000\000\000\001\030\001.\0018\000\000\000\000\000\000\001.\000\000\001\021\000\000\000\000\000\000\006\138\001\021\000\000\000\000\001\030\001\026\0018\000\000\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\000\000\001\030\001.\0018\000\000\000\000\001\030\000\000\001/\001\021\000\000\000\000\001\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\001\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\001\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\003\222"))
+ ((16, "\000\025\0017\000\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000*\000\000\000\000\001\136\000h\000&\000\243\002\b\000L\000K\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\131\000\000\000\000\000\000\000<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000,\250\000\000\000\000\001\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\148\001`\002v\000\203\000\000\002\156\t$\001j\002\210\000\025\000\000\000|\000\000\000Z\002\174\000\000\002X\000\000\000\000\000\000\000\000\000\000\000$\000\000\000\r\003\162\0074\000\000\000\000\000\190\003\148\000\000\000\000\000\b\000\000\001\020\000\000+`\002\216\000\000\002\222\001B\000\000\000\000\003*\003f\000\222\003\016\000&\003\162\004&\001\176\003h\001\128\003f\003\138\t\208\000\000\000\000\005F\003n\004\026\000\173\000\000\000\000\000\000\000\000\000\000\000\000\004F\000\000\005\226\000\000\005F\n\016\000\000\000\000\003\130\004L\003\236\028\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\000\004.\004^\004\178\000\000\000\000\000\000\000\000\000\191\000\000\000\000\005B\000%\005l\005h\006\194\004\176\004\228\005t\001~\002\168\006\014\029\020\000\000\000\000\005\006\006\018\nD\000\000\029V\004\168\nd\n\164\000\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\224,\252\005\244\000\000\n\168\006 \000\000\011<\029r\000Q\000\000\011L\005\202\000\000\000\000\000\000\006T\000\000\004\228\000\000\006J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\018\002\030\000\000\000\000\001\160\000\000\r\230\000\000\001\018\005@\001\018\000\000\000\000\000\000\000\000\000\000\029\174\000\000\006\030\006\176\000\000\021\170\006D\006\246\000\000\000\000\000\000\006J\000\000\000\000\000\000\000\000\003\130\000\000\000\000\000\000\000\000\000\000\011\166\000\000\000\000\000\000\000\000\000\000\000\000\004f\006\228\000\000\000\000\000\000\003\130\007<\029\234\006\178\006T-(\000\000\001\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\000\000\000\000\000\000\007\208\029\252\000\000\000\000\006\214\006h\030\156\000\000\000\000\000\000\030\190\006\212\030\208\000\000\006\212\000\000\030\220\006\212\000\000\031B\006\212\006\212\000\000\000\000\006\212\000\000\000\000\031v\000\000\006\212\031\166\000\000\006\212\bz\000\000\000\000\n\164\000\000\000\000\000\000\000\000\006\212\011\148\000\000\000\000\000\000\006\212\000\000\001z\007\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\n\000\000\007\178\000\000-X\003\130\000\000\000\000\000\000\000\000\007\208\bJ\011\240\007\200\b.\b6\006z\004\240\006\188\000G\b\172\000\000\000\000\000I\000?\006\196\000f\b\162\001\158\000\000\000e\000\230\003R\002\230\t\254\000\000\000\000\019\"\000\0001\234\t\164\000\000-d\003\130-\160\003\130\000\000\tV\000\000\tx\000\000\000\000\t\140\000\000\000\000\000\000\nf\000\000\001\220\000e\000\000\000\000\tL\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000e\000\000\b\162\005\\\000\000\000}\002\168\000\000\000}\000\000\000\000\002v\000e\000\000\000\000\000\000\000\000\000\000\000\000\000}\012 \012H\nf\n8\031\176\015\144\000\000\t\232\007\020\012\148\n\004\0070\nl\027\002\000\000\000\000\000\000\000\000\000\000\0118\b\128\000\000\000\000\000\000\n\016\007b\006*\000}\003\210\000\000\000e\000\000\000\000\000\000\004\168\000\000-\194\003\130\012\238\n\024\007n\012\244\n4\007\196\002\250\r\186\006\212\rH\n<\007\216,<\n\244\000\000\003n\006\212.D\003\130\n\248\000\000\000\000\000\000\000\000\000\144\n\234\n\250\000\000\000\000\007|\rh\n\130\b& \n\006\212\r\168\n\134\bH\027<\000\000&B\000\000\000\000\014\b\031\232\0246\000\000\000\000\000\000\000\000)\004\000\000\000\000\000\000\004\150\014f\000\000\000\000\000\000\000\000 L,\208\000\000\000\000\000\000\000\000\n|\014\194\000\000\n\154 \170\n\154 \176\n\154\000\0000\232\000\000 \216\n\154\014\242\003\152\015 \000\000\000\000!\000\n\154!\b\n\154!d\n\154!\190\n\154!\200\n\154\" \n\154\"N\n\154\"|\n\154\"\172\n\154#\002\n\154# \n\154#v\n\154#\166\n\154#\196\n\154#\214\n\154$\006\n\154$z\n\154$\170\n\154%\n\n\154%:\n\154\bn\006\002\002\004\000\144\011L\000\000\000\130.n\000\000\015~\000\000.^\000\000\003\130\003x\000\000\003\130.h\003\130\000\000\015\172\000\000\000\000\000\000\015\236\000\000\000\000\000\000\000\000\000\000\006\212\000\000\000\000.\198\000\000\003\130\000\000\000\000\003x\011R\000\000.\208\003\130\016\006\000\000\000\000\n\246\000\000.\210\003\130\016H\000\000\000\000\016|\000\000\000\000\000\000/$\003\130\016\158\000\000\n\218\016\224\000\000%\\\000\000\006\212%\150\000\000\006\212%\252\000\000\006\212\012@\000\000\000\000\000\000\000\000\000\000&&\006\212\005V\006\176\000\000\000\000\000\000\n\154\017\004\000\000\000\000\000\000&\004\n\154\000\000\000\000\000\000\000\000\017T\000\000\000\000\000\000\n\154\017\194\000\000\018\020\000\000\000\000\000\000\018`\000\000\000\000\000\000\000\0001\136\000\000\000\000\018h\000\000\000\000\000\000&\148\n\154\018\156\000\000\000\000\000\000&\204\n\154\018\248\000\000\000\000&\238\n\154\n\154\000\000\006n\019l\000\000\000\000'\028\n\154\019\186\000\000\000\000'\\\n\154't\n\154\000\000'\172\n\154\000\000\000\000\019\210\000\000\000\000(6\n\154\020\020\000\000\000\000(<\n\154\020,\000\000\000\000(t\n\154\000\000(\146\n\154\000\000\0038\000\000\000\000\n\154\000\000\000\000\020x\000\000\000\000\020\160\000\000\000\000\011,\000\000\000\000\020\238\000\000\021,\000\000\000\000\000\000\000\144\011\194\000\000)&\006\174\001\018\021L\000\000*(\000\000\000\000\000\000*p\000\000\000\000\021\212\000\000\022\002\000\000\000\000\000\000\000\000\022$\000\000\000\000\000\000(\198\n\154(\212\n\154\000\000\n\218\022d\000\000\000\000\022\196\000\000\023\030\000\000\000\000\027\002\000\000\000\000\000\000\0238\000\000\000\000\000\000\000\000\023l\000\000\000\000\000\000\000\000\0128\000\000\000\000\000\000,N\000\000\002\024\000\000\002\190\000\000\011\228\000\000\002H\000\000\000\000\000\000\000\000\000\000\000\000\0118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\154\000\000\012@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bx\006\142\000}\023\140\000\000\011v\b\164\011\234\001\186\006\154\000}\003\218\000e\b\130\000}\000\000\023\174\000\000\003\174\000\000\011|\b\200\011z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\194\002V\000\207\000\000\000\000\000\000,T\000\0001\242\000\000\tZ\000\000\tf\000\000\000\000\000\000\000\000\001Z\000\000\000\000\000\000\b\198\001\018\000\000\001\018\004\146\000\000\nN\001\018\001\018\t\162\000\000\023\222\000\000\t\230\012\144\000\000\024\136\006\240\000\000\000\000\000\000\000\000\000\000\000\000\n\154\000\000\007b\000\000\n\154\000\000\000\000\004T\000\000\000e\000\000\0058\000\000\000e\000\000\005B\000e\000\000\000}\000\000\n\022\b\138\000a\000\000\011\204\011\248\n6\012\024\012\176\005\138\000e\006\244\000\000\n@\012\196\012\210\006\188\007\228\012\190\nz\012\238\006\212\b\180\012\214\000\000\000\000\0072\tt\000\000\0066\002\156)\182\006\212\024\018\000\000\b\014\002\218\012\154\n\150\b\244\000\186\000\000\012\192\n\164\014\000\000\000/0\003\130\rn\r\168\000\000\t\148\000\000\r*\n\188\r\"\rH\002p\000\000\000\000\000\000\000\000\000\000\n\192\t\166\000\000\n\212\t\190\000\000\006\248\017\244\rN\rT\n\226\r\196\t\214\000\000\n\232\r\198\n(\000\000\r`\n\240\r\222\000\000\r\218\000\000\nh\000\000\r\230\000\000\007\128\000e\r\194\011\000\r\244\000\000\007\130\002\130\r\206\000\000\000\000\003l\014\006\n~\000\000\007\208\000e\n\240\000\000\003\246\000\000\r\162\011\n\t\242\002\188\000\000\r\168\011\026\r\156\rH\r\176\r\178\011\"\014\242\000\000\r\216\001\182\000\000\000\000\000\000\000\000\000\206\011,\r\178/B\003\130\000\000\000\181\011F\014R\000\000\000\000\000\000\000\000\000\000\000\000/N\003\130\000\000\011V\014\158\000\000\000\000\000\000\000\000\000\000\000\000\017\014\000\000/\160\003\130\011\178\000\000\003\130\011Z\002(\000\000\000\000\011l\011\162\014R\000\000\0030,\146\000\000\002\178\000\000\000\000\000\000\000\000/\254\003\130\003\130\000\000\000\000\0042\000\000\014T\000\000\b \0042\0042\000\000\011\168,d\003\1300\n\003\130\011\180\000\000\000\000\000\000\000\000\011\224\000\000\000\000\000\130\000\000\005F\0142\011\180\015*\014\b\000\000\000\000\t6\005\232\014F\000\000\000\000\011\182\0158\014,\000\000\000\000%n\000\000\001\218\000\000'\156\024:\003\130\000\000/\148\003\184\000\0000^\000\000\000\000\000\000\000\000\000\000\0042\000\000\000\000\011\240\014h\011\184\015`\0146\000\000\000\0000z\012R\014t\000\000\000\000\000\000 T\000\000\000\000\000\000\000\000\000\000\000\000\012n\000\000\014\130\011\198\004L\000\000\015X\015\n\012r\014\138\000\000\000\000\014\148\011\228\004\228\000\000\000\000\007\182\029r\003\014\000\000\000\000\000\000\0146\014\\\012\b\000\000\014`\0146\000\000\015\028\012\144\014\162\000\000\000\000\000\000\003\130\005t\005\254\tp\000\000\000\000\000\000\000\000\014h\012\014\000\000\n(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\130\014V\012\026\015\144\014h\000\000*\140\000F\012 \014D\003\248\0004\0128\014\232\000\000\015\140\024\226\000\000\000\000\025\018\000\000\012\196\000\000\004\150\000\000\000\000\000\000\000\000\000\000\000\0000\028\003\130\000\000\015\142\025:\000\000\000\000\025j\000\000\002\\\012T\015B\000\000\000\000\019H%V\015\004\000\0000\198\003\130\025\136\000\000\000\000\025\224\000\000\000\000\012\226\000\000\005\208\000\000\000\000\000\000\000\000\000\000\000\000*\186\000\000\000\000+2*\226\015\006\000\0000\228\003\130\026\002\000\000\000\000\026Z\000\000\000\000\012X\026\136\012\234\000\000\012Z\012r\001\150\004\166\012|\b\238\012\152\015T\026\172\012\254\000\000\012\174\012\180\014\250\000\000\007\240,\214\000\000\007&\000\000\012\182+N+\\\br\014n\t4\000\0001\026\0038\000\000\005\160\000\000\000\000\005\160\000\000\000\000\005\160\015\016\000\000\011\142\005\160\015p\0270\r\000\000\000\005\160\000\000\000\0001\"\000\000\000\000\000\000\005\160\000\000\000\000\r\\\000\000\r\250\b\140\rf\000\000\012\184,\226\r\128\000\000\000\000\000\000\000\000\r\142\000\000\000\000\004X\000\000\005\1601B\000\000\014x\005\160+\150\000\000\r\146\014\238\012\232\015\228\014\186\000\000,\b\r\148\014\244\000\000\000\000\000\000#\216\007\200\000\000\000\000\000\000\000\000\000\000\000\000\n|\r\158\000\000\015\006\000\000\000\000\000\000\000\000\r\182)\164\000\000\000\000\000\000\000\000\n|\000\000\000\000\r\216)\250\000\000\000\000\000\000\000\000\000\000\000}\000e\000\000\000\000\006\212\000\0001Z\003\130\000\000\005\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\188\r\026\n\030\000}\000\000\nV\000\000\000e\000\000\015\228\000\000\000\000\000\000\000\000\000\000\b\176\000\000\000\000\000\000\000\000\000\000\000\000\015\140\000e\014\188\014\\\b$\r:\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014h\b\208\r^\000\000\007\252\015\242\015\170\r\224\000\000\000\000\015\158\000%\003\142\000\000\000\000\000\000\rh\000\000\rl\001\026\000\000\000\000\001\018\001D\000\000\000\000\000\000\000\000\000\000\014\254\000\000\000\000\n&\007\168\000\000\000\0001\196\003\130\003\130\000\0001\208\003\130\011(\000\000\000\000\000\000\003\130\000\000\000\000\007\218\015\176\014H\000\000\000\000\015\164\007L\0016\000\000\000\000\000\000\000\000\n4\015\242\bb\015\198\014V\000\000\000\000\015\186\b\242\005\\\000\000\000\000\000\000\000\000\000e\000\000\005\248\000\000\000\000\000\000\027J\000\000\027b\000\000\000\000\000\000\000\000\000\000\b\206\000\000\000\000\000\000\t\144\000\000\003\130\000\000\tp\000\000\000\000\000\000\028$\006\212\000\000\000\000\004\014\015$\001p\000\000\000\000\000\000\000\000\000\000\000\000\0118\000\000\000\000\000\000\000\000)b\000\000\014b\000\000\000\000\000\000\000\000\004L\005\166\027\230\028\026\000\000\000\000\014r\028\150\000\000\000\000\000\000\014\132\028\194\000\000\000\000\000\000\000\000"), (16, "\006\016\003\223\002\b\002\t\001\187\000\139\006\179\006\165\001\204\002\238\001\187\000;\0062\001\219\006`\006\157\002L\006\017\006\190\001\219\006\019\002\238\001\245\002\238\002M\001\014\001\232\000\189\006\132\006\020\006!\006\016\004\229\002\b\002\t\000\139\001\245\002[\000\148\005v\006X\003\234\003\236\003\238\0007\000?\006t\002L\006\017\006 \001\223\006\019\001\017\000q\0007\002M\001\223\004\232\006\021\000m\006\020\006!\000\139\004\027\001\224\000\144\001\234\000\\\002[\001\187\001\224\001\230\004\234\000\189\001\187\004y\001\227\004\031\001\219\000\139\001[\000\149\001\204\001\219\000`\0007\006\022\001[\002\175\006\021\002]\004\235\0061\006\183\006\023\001\247\002\178\000\145\000\193\001\\\002\179\002\012\001^\001_\006d\006e\001\\\001l\001\019\001^\001_\006&\001\185\006f\006g\001\223\001\014\006\022\001\019\001\015\001\223\002]\001\226\001\212\006h\006\023\006'\001\246\000\139\001\224\006l\001\204\002\012\001\019\001\224\006\026\006d\006e\006\192\001\218\006\028\001\246\006&\001\017\001\n\006f\006g\001\248\000\189\001m\006\030\001n\002\186\002_\005x\002e\006h\006'\001 \001\014\005A\002k\001\014\002a\002\238\006\031\006\026\001c\000m\001\028\001\213\006\028\005\205\006\016\001u\002\b\002\t\001\245\001d\000d\001!\006\030\002m\001\014\002_\001d\002e\004\236\001a\002L\006\017\006 \002k\006\019\002a\001%\006\031\002M\006\216\002\t\005\207\000:\006\020\006!\006\016\002\180\002\b\002\t\001\226\001\019\002[\0009\004\232\002m\005\208\000\194\002\238\004\205\004E\005\210\002L\006\017\006 \005\254\006\019\002\182\002\238\004\234\002M\001\014\001w\006\021\001\"\006\020\006!\006v\000\139\001w\001\146\000\144\001b\002[\000=\000\250\001W\001x\004\235\001b\000\253\005H\005I\001\019\001\019\0015\006\130\001\019\001\017\006}\001\014\006\022\001\028\005\001\006\021\002]\006\150\006\151\006U\006\023\004\212\005R\006a\004\156\001\000\001[\002\012\001\234\001\019\003\223\006\128\004\213\006\161\002\208\001\246\004\237\006&\001\017\001%\002\238\001?\002\211\006\022\000x\001\\\002\179\002]\001^\001_\006\217\006\023\006'\006b\004\026\000\250\001\028\001\247\002\012\001\028\001\153\006\026\006c\006\162\003\154\001\187\006\028\001\188\006&\000\189\003\237\003\236\003\238\001\014\001\219\001\019\006\030\006\185\001b\002_\001\028\002e\006~\006'\001\000\006~\003\204\002k\003\160\002a\001\019\006\031\006\026\005\205\006W\000\127\001\187\006\028\001\217\006\016\000\133\002\b\002\t\003\239\001\019\001\219\006~\006\030\002m\001\248\002_\001\223\002e\001c\000\143\002L\006\017\006 \002k\006\019\002a\005\207\006\031\002M\001d\001\224\001\028\003\156\006\020\006!\006\016\003\207\002\b\002\t\000\250\005\208\002[\000\189\000\194\002m\005\210\000@\001\223\004\205\005\233\002\238\002L\006\017\006 \001[\006\019\002\180\001%\0007\002M\001\028\001\224\006\021\000\250\006\020\006!\006(\000\139\003\155\000\173\001\204\001\019\002[\001\\\001l\005\153\001^\001_\001\187\002\238\001\242\001w\001\234\004X\002\b\002\t\001%\001\219\005\155\001\146\006\022\001b\003\155\006\021\002]\003\157\003r\006$\006\023\004\212\000\139\000\128\001\191\001\204\004\127\002\012\003G\000\194\001\238\000\142\004\213\001\247\001[\001\031\004\220\006&\001m\004\205\001n\002(\000\131\006\022\001\028\001\014\001\223\002]\001\015\0007\003\242\006\023\006'\001\\\001l\004\144\001^\001_\002\012\001\014\001\224\006\026\001\015\001u\000\250\004[\006\028\000\175\006&\000\134\003\243\000\194\001\017\0007\001d\003\223\006\030\001\014\003u\002_\005\b\002e\002\201\006'\000\194\001\248\001\017\002k\006\135\002a\001\218\006\031\006\026\001\192\002\011\000\164\001m\006\028\001n\0020\002\238\004\208\004\205\000\194\001\017\002\012\002\238\006\030\002m\001!\002_\006\016\002e\002\b\002\t\005:\003\236\003\238\002k\001\218\002a\001u\006\031\001!\006\220\006\221\001w\002L\006\223\004\136\000\194\006\019\001d\003I\001x\002M\001b\000\166\001\019\002m\006\020\006\225\006\016\000\171\002\b\002\t\006\240\000\139\002[\005+\001\204\000\170\001\019\004\212\004\177\0023\006\232\002_\002L\006\233\006u\000\181\006\019\003\208\004\213\002`\002M\002a\004\214\006\021\001\019\006\020\006\241\000\176\001\187\004\138\002\024\005}\001\187\002[\003\201\000\180\0015\001\219\001w\000\186\001\014\001\219\002\238\001\028\006b\001\158\001x\002\172\001b\000\203\0015\006\022\004\139\006c\006\021\002]\001K\001\028\000\194\006\023\000\178\006\142\003\207\005\246\001\\\002\029\002\012\001^\001_\001%\003\239\001?\001>\006\228\001\223\001\028\000\194\000\139\001\223\0055\001\204\001\014\006\022\001%\002q\001?\002]\000\187\001\224\005\249\006\023\006'\001\224\001\187\001[\004\017\004\221\002\012\004\138\001N\006\026\001%\001\219\006\245\005\251\006\028\003|\002\233\002\234\000\195\004\007\005\253\000\204\001\\\002\179\006\030\001^\001_\002_\006:\002e\000\217\006'\002\b\002\t\005\129\002k\001\014\002a\005\252\006\031\006\026\001u\001\019\002\251\000\216\006\028\005\249\006\016\001\223\002\b\002\t\000\189\001d\000\220\006B\006\030\002m\000\194\002_\001\234\002e\005\251\001\224\002L\006\017\006.\002k\006\019\002a\004\215\006\031\002M\003\012\003\127\003\132\005\205\006\020\006!\006\016\000\194\002\b\002\t\000\194\001\019\002[\001\249\005\252\002m\001\247\002\238\001c\000\194\006\232\001\028\002L\006\233\005\160\002\238\006\019\003\245\002\238\001d\002M\005\207\001w\006\021\005A\006\020\006\236\004\028\002\b\002\t\001x\001\234\001b\002[\001\187\005\208\004\021\003\248\002\011\001\187\005\210\004\024\002L\001\219\005\226\002\158\002\180\001\019\001\219\002\012\002M\006\022\001\028\000\232\006\021\002]\006L\001\235\001\248\006\023\001\247\004\238\000\226\002[\002\212\001l\002\012\001^\001_\002\240\000\240\001w\006\175\005\236\005\164\001\187\006&\004&\001\029\001\146\001\223\001b\006\022\000\228\001\219\001\223\002]\000\233\002\238\0007\006\023\006'\001\014\005A\001\224\001\015\002\238\002\012\001\028\001\224\006\026\002_\006\162\006\239\001P\006\028\002\217\002\233\002\234\002`\000m\002a\001\248\005H\005I\006\030\002]\001\004\002_\001\017\002e\001\223\006'\000\194\001'\004\215\002k\002\012\002a\005Y\006\031\006\026\001u\005R\001\234\001\224\006\028\001\014\006\016\001\007\002\b\002\t\004\246\001d\000\194\006;\006\030\002m\000\194\002_\006\182\002e\002b\001\r\002L\006\017\001!\002k\006\019\002a\002\021\006\031\002M\001\247\000\236\005\030\000\241\006\020\006*\002\237\005\212\005\249\001<\001\014\001\014\002[\001\015\001\015\002m\002_\001\022\002e\005H\005I\001\234\001\019\005\251\002k\002\238\002a\001\234\001:\005\031\005_\005 \001w\006\021\0033\005Q\001T\001\017\001\017\005R\001x\001\014\001b\004\215\001\015\002m\001k\003\191\005\252\0012\001\247\001>\001\248\003\199\0019\001\175\001\247\002\238\001[\002\238\005!\006\022\000\194\003D\000\194\002]\001(\001\019\001\017\006\023\000\194\001[\004-\001\028\001!\001!\002\012\001\\\001l\002\239\001^\001_\001M\004:\0042\005A\006-\005\"\001\177\000\194\001\\\002\179\001\184\001^\001_\006\160\005#\000\194\005$\001%\004\011\006'\001\248\001\019\001\019\001!\001\014\000\194\001\248\001\015\006\026\004\002\001\148\004(\005`\006\028\000\194\003\207\001\028\006\152\001m\001S\001n\002(\001\014\006\030\000\189\001\015\002_\003\207\002e\0047\002\003\001\017\001\019\001\145\002k\005&\002a\001j\006\031\006q\005(\0052\003b\001u\002\006\0015\0015\000\194\005A\001\017\005\\\000\194\001\028\001\028\001d\002m\001c\005a\003u\001t\0007\001\187\001\187\004x\004~\005]\005A\001d\001!\002\020\001\219\001\219\005H\005I\003\207\002#\0015\002\238\001%\001%\0016\001?\005D\001\028\006\163\006\164\001!\005J\005Z\000\189\001\014\000\194\005R\001\015\003e\005\200\001\136\001\019\002\b\002\t\006\154\001\187\001\152\004\135\005R\000\194\001w\001\223\001\223\001%\001\219\001?\002L\003h\001x\001\019\001b\001\017\002&\001w\002M\001\224\001\224\001[\001\164\000\189\003\134\001\146\002,\001b\000\194\004.\001\019\002[\005A\005\030\000\194\005H\005I\001\169\001\014\0015\001\\\001l\004\004\001^\001_\001\223\001\028\005\205\004\205\004X\005J\005Z\001!\005H\005I\005R\003\253\0015\006\138\001\224\005\031\006\194\005 \006T\001\028\002A\006\168\001\234\005J\005Z\0007\001\234\001%\005R\001?\005\207\005\030\000\194\000m\002\238\005\240\001\019\002F\001m\002]\001n\002(\000\194\000\189\005\208\001%\005!\001?\003\203\005\210\002\012\001\247\004\030\005\217\004\212\001\247\002\157\006\174\005\031\006\176\005 \003\190\003\189\001u\006^\004\213\001\174\005\205\001\180\004\219\004@\002\b\002\t\005\"\001d\002b\005H\005I\003u\001\234\0015\000\194\005#\003\196\005$\002L\001\019\001\028\0043\005!\004X\005J\005Z\002M\001\014\005\207\005R\001\015\000\194\006\202\005`\003\211\002_\001\248\002e\004D\002[\001\248\001\247\005\208\002k\001\225\002a\001%\005\210\001?\005\"\000\194\005\214\002\b\002\t\001\017\000\194\005&\006\196\005#\001w\005$\005(\0052\002\238\002m\005\212\002L\001x\001\197\001b\001\028\005\\\006\204\000\189\002M\004\205\005`\000\194\001\199\002\238\006Q\006\163\006\164\006j\002\b\002\t\005]\002[\002\238\006\198\001\206\001!\002]\001\248\003\223\000\194\003\241\005\205\002L\005&\002\238\005R\006\139\002\012\005(\0052\002M\003\230\001\208\006\171\002\b\002\t\002\238\003\232\005\\\005\187\006?\0048\001\211\002[\001\019\001\215\001\014\001\222\002L\005\207\004\212\001[\002b\005]\002\b\002\t\002M\004P\005N\003\236\003\238\004\213\004\t\005\208\002]\004\245\004]\003\250\005\210\002[\001\\\001l\005\211\001^\001_\002\012\003\169\002\238\004`\002_\001\155\002e\003\182\001[\001\187\001\234\004\143\002k\0015\002a\004h\001\014\000\194\001\219\001\015\001\028\002]\001)\000\194\006\199\002b\003\254\001\\\001l\003\178\001^\001_\002\012\002m\002\238\003\223\006F\001\139\001m\001\247\001n\001\142\001*\001\017\001\019\002\238\001%\002]\001?\001H\004\029\001\019\002_\000\194\002e\001\223\004l\002b\002\012\001\187\002k\006J\002a\001u\001\019\002\002\004#\002\011\001\219\001\224\001m\004*\001n\001\142\001d\005V\003\236\003\238\002\012\002\005\001!\002m\003\168\002b\002_\002\019\003\001\000\194\004t\002\"\001\014\001\248\002k\001\015\002a\001u\001)\001/\001\014\004\133\0040\001\015\002\238\002%\001)\001\223\001d\002+\0027\001\019\002_\000\194\002e\002m\004C\001\028\001*\001\017\002k\001\224\002a\004H\0024\001F\001*\001\017\001w\000\194\001[\002<\002_\001+\000\194\004S\001x\004\\\001b\002;\002`\002m\002a\003\247\002@\001\014\002E\004_\001\015\001\\\001l\001)\001^\001_\004f\0015\001!\004j\004\137\001\144\001w\004o\001\028\000\194\001!\003\223\001=\002\241\001x\004{\001b\001*\001\017\001/\004\142\002\b\002\t\000\194\001D\002j\002\161\001/\004\147\002\196\000\194\001\019\004\152\002\203\001%\002L\001?\004\162\001m\001\019\001n\001\142\000\194\002M\000\194\002\b\002\t\002\238\002\238\004\003\004\168\006\147\003\236\003\238\000\194\001!\002[\002\232\004\179\002L\004\194\000\194\002\231\001u\000\194\002\b\002\t\002M\000\194\004\216\002\238\000\189\001/\003\188\001d\0015\000\194\003W\002\238\002L\002[\000\194\001\028\0015\001\019\003_\001=\002M\003\148\000\194\001\028\003\158\003\180\000\194\001=\005\205\004\199\003\185\000\194\004\223\002[\004\191\004\228\002\b\002\t\004\240\004\250\005\021\001%\002]\001?\000\194\003\195\003\197\005*\003\210\001%\002L\001?\000\194\002\012\000\194\003\219\005\207\004\233\002M\001w\002\238\0015\0054\000\194\003\171\005\019\002]\001x\001\028\001b\005\208\002[\001=\003\249\002\238\005\210\002\238\002\012\002b\005\221\005@\002\b\002\t\005T\002\b\002\t\002]\004\000\004)\005d\000\194\002\238\005j\000\194\001%\002L\001?\002\012\002L\000\194\000\194\000\194\002b\002M\005n\002_\002M\002e\000\194\003{\004\"\004$\003v\002k\005\027\002a\002[\002\238\005\138\002[\005\178\005\238\002b\000\194\002]\004'\002\b\002\t\005'\002_\005/\002e\002\238\005\183\002m\002\012\002\238\002k\005\222\002a\002L\000\194\002\b\002\t\000\194\005F\002\238\002\238\002M\002_\000\194\003\001\005\188\000\194\003k\0046\002L\002k\002m\002a\002b\002[\004,\005\218\002M\000\194\005\194\005\202\005\243\002]\003\\\005w\002]\0045\002\b\002\t\0041\002[\002m\000\194\002\012\000\194\000\194\002\012\001[\0044\005\154\002_\002L\002e\005\180\004B\006\b\002\238\000\194\002k\002M\002a\002\238\000\194\005\191\005\225\003T\001\\\001l\002b\001^\001_\002b\002[\004G\002\238\001\014\000\194\002]\001\015\002m\006E\002\238\004I\002\238\002\238\002\b\002\t\000\194\002\012\002\238\000\194\000\194\000\194\002]\004O\002_\006_\002e\002_\002L\002e\002\238\001\017\002k\002\012\002a\002k\002M\002a\001m\005\237\001n\002(\002b\006k\005\241\000\194\003L\002\238\006y\002[\006{\002\238\004N\002m\002]\004R\002m\005\245\002b\004T\004^\002\b\002\t\001u\005\250\002\012\006\006\006\r\001!\002_\000\194\002e\006\027\004i\001d\002L\004e\002k\003q\002a\004g\004k\004n\002M\006\"\002_\000\194\002e\004\130\002X\002b\004s\004v\002k\004\129\002a\002[\001\019\002m\004|\004\128\006+\002]\002\238\000\194\006p\000\189\002\b\002\t\000\194\002\238\000\194\004\132\002\012\002m\004\141\002\238\002_\004\146\002e\004\148\002L\004\249\004\151\002\238\002k\001w\002a\004\154\002M\005\205\002\b\002\t\002\238\001x\002d\001b\004\158\002b\004\166\004\173\001$\002[\004\184\001\014\002L\002m\001\015\001\028\002]\004\200\004\217\004\248\002M\002\b\002\t\004\241\006\156\005\207\002s\002\012\004\242\004\247\004\251\006\170\002_\002[\003\001\002L\000\189\006\226\001\017\005\208\002k\001%\002a\002M\005\210\006\237\004\252\005\029\005\239\002r\005\022\005\023\002b\005\028\006\242\0051\002[\005-\005.\0050\005\205\002m\002]\005[\005>\005?\005C\005E\002\b\002\t\005G\005S\005c\002\012\005e\001!\005f\002\b\002\t\002_\005k\002e\002L\005o\005s\005\133\002]\002k\005\207\002a\002M\002\b\002\t\005\140\005\144\005\168\002\166\002\012\002b\003\152\005\189\005\195\005\208\002[\001\019\002L\003\161\005\210\002m\002]\005\213\006\002\005\219\002M\005\223\006\015\006\t\006\n\006\014\002\177\002\012\006\029\002b\006D\001[\002_\002[\002e\006O\003\174\006Z\006\\\002\175\002k\006n\002a\002\b\002\t\006o\006s\002\178\006\155\006\159\001\\\002\179\002b\001^\001_\006\134\002_\002L\002e\006\169\006\173\002m\001\028\002]\002k\002M\002a\006\211\000\000\000\000\000\000\002\200\002\011\000\000\002\012\000\000\002\b\002\t\002[\002_\000\000\002e\000\000\003\165\000\000\002m\002]\002k\001%\002a\002L\000\000\000\000\000\000\000\000\000\000\000\000\002\012\002M\002b\000\000\000\000\002\b\002\t\002\207\000\000\000\000\000\000\002m\000\000\000\000\002[\003\155\000\000\000\000\000\000\002L\000\000\001c\002\b\002\t\000\000\002b\000\000\002M\000\000\002_\000\000\002e\001d\002\210\002]\000\000\002L\002k\002_\002a\002[\000\000\000\000\000\000\002M\002\012\002`\000\000\002a\000\000\002\216\000\000\002_\000\000\002e\002\b\002\t\002[\002m\002\180\002k\000\000\002a\000\000\000\000\000\000\000\000\002]\000\000\002L\002b\000\000\000\000\002\b\002\t\000\000\000\000\002M\002\012\002\181\000\000\002m\000\000\002\219\001w\001\014\000\000\002L\001\015\000\000\002[\000\000\001\146\002]\001b\002M\000\000\002_\000\000\002e\000\000\002\244\000\000\002b\002\012\002k\000\000\002a\002[\000\000\002]\000\000\001\017\002\b\002\t\000\000\000\000\000\000\000\000\000\000\000\000\002\012\004\187\000\000\000\000\000\000\002m\002L\000\000\002b\002_\000\000\002e\000\000\000\000\002M\000\000\004\190\002k\000\000\002a\000\000\000\000\002]\000\000\002\254\002b\000\000\002[\001!\000\000\000\000\000\000\000\000\002\012\000\000\002_\000\000\002e\002m\000\000\002]\000\000\000\000\002k\000\000\002a\000\000\002\b\002\t\000\000\000\000\002\012\002_\000\000\002e\000\000\000\000\001\019\002b\000\000\002k\002L\002a\000\000\002m\000\000\000\000\000\000\000\000\002M\005\030\000\000\000\000\000\000\000\000\000\000\002b\000\000\000\000\003\003\002]\002m\002[\000\000\000\000\002_\000\000\002e\002\b\002\t\000\000\002\012\000\000\002k\000\000\002a\000\000\005\031\000\000\005 \000\000\0015\002L\002_\000\000\002e\000\000\000\000\001\028\000\000\002M\002k\004\192\002a\002m\000\000\002b\000\000\000\000\000\000\003\005\000\000\000\000\002[\000\000\000\000\002\b\002\t\005!\000\000\002\b\002\t\002m\000\000\001%\002]\001?\000\000\000\000\000\000\002L\000\000\000\000\002_\002L\003\001\002\012\000\000\002M\000\000\000\000\002k\002M\002a\000\000\005\"\002\b\002\t\003\t\000\000\000\000\002[\003\017\000\000\005#\002[\005$\000\000\000\000\000\000\002L\002b\002m\000\000\000\000\000\000\002]\000\000\002M\000\000\000\000\000\000\005^\000\000\000\000\000\000\000\000\002\012\003\023\000\000\000\000\002[\000\000\000\000\000\000\000\000\000\000\000\000\002_\000\000\003\001\000\000\002\b\002\t\000\000\005&\002k\000\000\002a\000\000\005(\0052\002b\000\000\002]\000\000\002L\000\000\002]\000\000\005\\\000\000\000\000\000\000\002M\002\012\000\000\002m\000\000\002\012\001\014\000\000\000\000\001\015\003\029\005]\000\000\002[\000\000\002_\000\000\003\001\000\000\001[\002]\000\000\000\000\002k\000\000\002a\002b\000\000\000\000\000\000\002b\002\012\000\000\001\017\000\000\005\152\002\b\002\t\001\\\002\179\000\000\001^\001_\000\000\002m\000\000\000\000\000\000\000\000\000\000\002L\000\000\000\000\002_\000\000\003\001\002b\002_\002M\003\001\000\000\002k\000\000\002a\003%\002k\002]\002a\000\000\000\000\001!\002[\000\000\000\000\000\000\002\b\002\t\002\012\000\000\000\000\000\000\000\000\002m\002_\000\000\003\001\002m\002\b\002\t\002L\000\000\002k\000\000\002a\000\000\000\000\000\000\002M\000\000\001\019\000\000\002L\002b\003*\000\000\000\000\001c\000\000\000\000\002M\002[\000\000\002m\000\000\000\000\000\000\000\000\001d\000\000\0036\002\b\002\t\002[\000\000\002]\000\000\000\000\000\000\000\000\002_\000\000\003!\002\b\002\t\002L\002\012\000\000\002k\000\000\002a\000\000\000\000\002M\0015\002\180\000\000\002L\000\000\000\000\000\000\001\028\000\000\003;\000\000\002M\002[\000\000\000\000\002m\000\000\002b\000\000\000\000\002]\003@\000\000\000\000\002[\000\000\001w\002\b\002\t\000\000\000\000\002\012\002]\001%\001\146\001\196\001b\000\000\000\000\000\000\000\000\002L\000\000\002\012\002_\000\000\002e\002\b\002\t\002M\000\000\000\000\002k\000\000\002a\000\000\002b\000\000\000\000\003O\000\000\002L\002[\000\000\000\000\002]\000\000\000\000\002b\002M\000\000\000\000\000\000\002m\000\000\000\000\002\012\002]\000\000\003R\000\000\000\000\002[\002_\000\000\002e\002\b\002\t\002\012\000\000\000\000\002k\000\000\002a\000\000\002_\000\000\003\001\000\000\000\000\002L\002b\000\000\002k\000\000\002a\000\000\000\000\002M\000\000\000\000\000\000\002m\002b\003X\002]\000\000\002\b\002\t\000\000\000\000\002[\000\000\000\000\002m\000\000\002\012\000\000\002_\000\000\003\001\002L\000\000\002\b\002\t\002]\002k\000\000\002a\002M\002_\000\000\003\001\000\000\000\000\003Z\002\012\002L\002k\000\000\002a\002b\002[\000\000\000\000\002M\000\000\002m\000\000\000\000\000\000\003d\000\000\000\000\000\000\000\000\000\000\000\000\002[\002m\000\000\002b\000\000\000\000\002]\000\000\000\000\000\000\002_\000\000\003\001\000\000\000\000\000\000\000\000\002\012\002k\001\014\002a\000\000\001\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002_\000\000\003!\002\b\002\t\000\000\000\000\002]\002k\002m\002a\000\000\002b\000\000\000\000\000\000\001\017\002L\002\012\000\000\000\000\000\000\000\000\002]\0013\002M\002\b\002\t\000\000\002m\000\000\003m\000\000\000\000\002\012\000\000\000\000\000\000\002[\002_\002L\002e\000\000\002b\001[\000\000\000\000\002k\002M\002a\000\000\000\000\000\000\001!\003p\000\000\000\000\000\000\000\000\002b\000\000\002[\000\000\001\\\001l\000\000\001^\001_\002m\000\000\002_\000\000\002e\000\000\000\000\002\b\002\t\000\000\002k\000\000\002a\000\000\001\019\000\000\000\000\000\000\002_\000\000\002e\002L\000\000\002]\000\000\000\000\002k\000\000\002a\002M\000\000\002m\000\000\000\000\002\012\003~\000\000\000\000\001m\000\000\001n\002(\002[\000\000\000\000\000\000\002]\002m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\b\002\t\002\012\0015\002b\000\000\000\000\000\000\001u\000\000\001\028\000\000\000\000\000\000\002L\000\000\000\000\000\000\000\000\001d\000\000\000\000\002M\003t\000\000\000\000\000\000\002b\003\129\000\000\000\000\002_\000\000\002e\000\000\002[\001%\000\000\001;\002k\002]\002a\000\000\000\000\000\000\000\000\002\158\000\000\000\000\000\000\000\000\002\012\000\000\000\000\002_\000\000\002e\000\000\002\b\002\t\002m\000\000\002k\000\000\002a\002\212\001l\000\000\001^\001_\000\000\001w\002L\000\000\000\000\000\000\002b\000\000\000\000\001x\002M\001b\000\000\002m\002\b\002\t\000\000\000\000\002]\000\000\003\139\000\000\000\000\002[\000\000\000\000\000\000\000\000\002L\002\012\002\b\002\t\000\000\002_\000\000\002e\002M\002\217\002\233\002\234\000\000\002k\000\000\002a\002L\000\000\003\144\002\b\002\t\002[\000\000\000\000\002M\000\000\002b\000\000\000\000\000\000\003\193\000\000\000\000\002L\002m\001u\000\000\002[\000\000\000\000\000\000\002M\000\000\002\b\002\t\000\000\001d\003\206\002]\000\000\000\000\000\000\000\000\002_\002[\002e\000\000\002L\000\000\002\012\000\000\002k\000\000\002a\000\000\002M\000\000\000\000\000\000\002\b\002\t\003\252\003\131\000\000\002]\000\000\000\000\000\000\002[\000\000\000\000\000\000\002m\002L\002b\002\012\000\000\002\b\002\t\000\000\002]\002M\000\000\000\000\000\000\000\000\001\014\004>\001w\001\015\000\000\002\012\001@\000\000\002[\000\000\001x\002]\001b\003G\002b\002_\000\000\003\001\000\000\000\000\000\000\000\000\002\012\002k\000\000\002a\001B\001\017\000\000\000\000\002b\000\000\004\203\002\158\000\000\002]\000\000\003H\000\000\000\000\000\000\002_\000\000\003\001\002m\000\000\002\012\002b\000\000\002k\000\000\002a\002\212\001l\000\000\001^\001_\002_\000\000\002e\000\000\002]\000\000\000\000\001!\002k\000\000\002a\000\000\000\000\002m\002b\002\012\000\000\002_\000\000\002e\002\b\002\t\002\011\000\000\001/\002k\000\000\002a\000\000\002m\000\000\000\000\000\000\002\012\002L\000\000\001\019\002\217\002\233\002\234\002b\002_\002M\002e\002\b\002\t\002m\000\000\005r\002k\000\000\002a\000\000\000\000\000\000\002[\000\000\000\000\002L\000\000\000\000\003J\000\000\001u\002\b\002\t\002M\002_\000\000\002e\002m\000\000\005u\000\000\001d\002k\000\000\002a\002L\002[\0015\000\000\000\000\000\000\000\000\002_\002M\001\028\002\b\002\t\000\000\005\004\005\132\002`\000\000\002a\002m\000\000\000\000\002[\004\001\000\000\002L\002\b\002\t\000\000\000\000\000\000\002]\000\000\002M\000\000\000\000\001%\000\000\001?\005\135\002L\000\000\002\012\000\000\000\000\000\000\002[\000\000\002M\001w\000\000\000\000\000\000\000\000\005\148\002]\000\000\001x\000\000\001b\000\000\002[\000\000\000\000\000\000\000\000\002\012\002b\000\000\000\000\002\b\002\t\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\000\000\002\012\002\b\002\t\000\000\000\000\002b\002M\000\000\002_\000\000\002e\000\000\005\151\002]\000\000\002L\002k\000\000\002a\002[\000\000\000\000\000\000\002M\002\012\002b\000\000\000\000\002]\005\172\000\000\000\000\002_\000\000\002e\000\000\002[\002m\000\000\002\012\002k\000\000\002a\000\000\000\000\002\b\002\t\000\000\000\000\002b\000\000\000\000\002_\000\000\002e\000\000\000\000\000\000\000\000\002L\002k\002m\002a\000\000\002b\000\000\000\000\002M\002\b\002\t\000\000\000\000\002]\005\175\000\000\000\000\002_\000\000\002e\000\000\002[\002m\002L\002\012\002k\000\000\002a\002\158\000\000\002]\002M\002_\000\000\002e\000\000\000\000\005\179\000\000\000\000\002k\002\012\002a\000\000\002[\000\000\002m\002\212\001l\002b\001^\001_\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002m\000\000\000\000\000\000\000\000\002b\000\000\000\000\000\000\002\b\002\t\000\000\000\000\002]\000\000\002_\000\000\002e\000\000\000\000\000\000\000\000\000\000\002k\002\012\002a\000\000\000\000\002\217\002\233\002\234\002\n\002_\002\158\002e\000\000\002]\000\000\002\b\002\t\002k\000\000\002a\000\000\002m\002\b\002\t\002\012\000\000\002b\000\000\000\000\002\212\001l\001u\001^\001_\002\b\002\t\002L\002G\002m\000\000\000\000\000\000\001d\000\000\002M\000\000\000\000\000\000\002L\002b\006\186\000\000\000\000\002_\000\000\002e\002M\002[\000\000\000\000\000\000\002k\006\188\002a\000\000\000\000\000\000\000\000\005\190\002[\000\000\002\217\002\233\002\234\002\011\000\000\002_\000\000\002e\000\000\000\000\000\000\002m\000\000\002k\002\012\002a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\001u\006\016\000\000\000\000\000\000\001x\002\011\001b\002m\000\000\000\000\001d\000\000\002]\000\000\006\232\000\000\002\012\006\233\000\000\000\000\006\019\000\000\000\000\002\012\002]\000\000\006\016\000\000\000\000\006\020\000\000\000\000\000\000\000\000\001[\002\012\005\224\000\000\000\000\002_\006\232\000\000\000\000\006\233\000\000\000\000\006\019\002`\002b\002a\000\000\000\000\000\000\001\\\001l\006\020\001^\001_\006\021\000\000\002b\000\000\001w\000\000\000\000\000\000\000\000\000\000\002_\000\000\001x\000\000\001b\000\000\000\000\002_\002`\002e\002a\000\000\000\000\000\000\000\000\002k\006\021\002a\006\022\002_\006\016\002e\000\000\000\000\000\000\000\000\006\023\002k\001m\002a\001n\006\206\006\208\000\000\006\232\000\000\002m\006\233\000\000\006\235\006\019\000\000\006\016\000\000\006\022\000\000\000\000\000\000\002m\006\020\000\000\000\000\006\023\001u\000\000\000\000\006\232\000\000\006\025\006\233\000\000\000\000\006\019\000\000\001d\006\234\000\000\006\026\000\000\001[\000\000\006\020\006\028\000\000\000\000\000\000\000\000\000\000\006\021\000\000\000\000\000\000\006\030\000\000\006\025\002\b\002\t\000\000\001\\\001l\000\000\001^\001_\006\026\000\000\000\000\000\000\006\031\006\028\002L\006\021\000\000\000\000\000\000\000\000\000\000\006\022\002M\006\030\000\000\000\000\000\000\000\000\000\000\006\023\000\000\001w\000\000\002\b\002\t\002[\000\000\000\000\006\031\001x\000\000\001b\006\238\006\022\000\000\000\000\001m\002L\001n\0065\000\000\006\023\000\000\000\000\001\014\002M\000\000\001\015\000\000\000\000\001@\006\025\000\000\000\000\006\243\000\000\000\000\000\000\002[\000\000\006\026\001u\000\000\000\000\000\000\006\028\000\000\000\000\000\000\000\000\001B\001\017\001d\006\025\001\014\006\030\000\000\001\015\002]\000\000\001)\000\000\006\026\000\000\000\000\000\000\000\000\006\028\000\000\002\012\006\031\000\000\000\000\000\000\000\000\000\000\000\000\006\030\001[\000\000\001.\001\017\000\000\000\000\000\000\000\000\000\000\001[\001!\000\000\000\000\002]\006\031\000\000\002b\000\000\000\000\001\\\001l\000\000\001^\001_\002\012\000\000\001w\001/\001\\\001l\000\000\001^\001_\000\000\001x\000\000\001b\000\000\000\000\001\019\001!\000\000\000\000\002_\000\000\004\012\000\000\000\000\000\000\002b\000\000\002k\000\000\002a\000\000\000\000\000\000\001/\000\000\000\000\000\000\000\000\001m\000\000\001n\001\147\000\000\000\000\000\000\001\019\000\000\001m\002m\001n\001}\000\000\002_\000\000\004\b\000\000\000\000\000\000\000\000\0015\002k\000\000\002a\001u\000\000\001[\001\028\000\000\000\000\000\000\001=\000\000\001u\000\000\001d\000\000\000\000\000\000\000\000\000\000\000\000\002m\001[\001d\001\\\001l\000\000\001^\001_\0015\000\000\001[\001%\000\000\001?\000\000\001\028\001[\000\000\000\000\001=\001\\\001l\000\000\001^\001_\000\000\000\000\000\000\000\000\001\\\001l\000\000\001^\001_\000\000\001\\\001l\000\000\001^\001_\000\000\001%\000\000\001?\000\000\001w\001m\000\000\001n\001z\000\000\000\000\000\000\001x\001w\001b\000\000\000\000\000\000\000\000\000\000\000\000\001x\001m\001b\001n\001p\001[\000\000\000\000\000\000\001u\001m\000\000\001n\001s\000\000\000\000\001m\000\000\001n\001v\001d\000\000\000\000\000\000\001\\\001l\001u\001^\001_\000\000\000\000\001[\000\000\000\000\000\000\001u\000\000\001d\000\000\000\000\000\000\001u\000\000\000\000\000\000\000\000\001d\000\000\000\000\000\000\001\\\001l\001d\001^\001_\001[\000\000\000\000\000\000\002\b\002\t\000\000\000\000\000\000\000\000\000\000\000\000\001m\000\000\001n\001y\000\000\001w\002L\001\\\001l\000\000\001^\001_\000\000\001x\002M\001b\000\000\000\000\000\000\000\000\002\b\002\t\001w\000\000\000\000\001u\001m\002[\001n\001\130\001x\001w\001b\000\000\002L\000\000\001d\001w\001[\001x\000\000\001b\002M\000\000\000\000\001x\000\000\001b\000\000\000\000\001m\001u\001n\001\133\000\000\002[\000\000\001\\\001l\000\000\001^\001_\001d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\b\002\t\005\030\000\000\000\000\001u\000\000\000\000\000\000\000\000\002]\000\000\000\000\000\000\002L\000\000\001d\000\000\001w\000\000\000\000\002\012\002M\000\000\000\000\000\000\001x\000\000\001b\005\031\001m\005 \001n\002B\000\000\002[\000\000\000\000\002]\000\000\000\000\000\000\000\000\000\000\001w\000\000\002b\002\b\002\t\002\012\002\b\002\t\001x\000\000\001b\001u\000\000\000\000\000\000\000\000\005!\002L\000\000\000\000\002L\000\000\001d\000\000\001w\002M\002\b\002\t\002M\002_\002b\003\177\001x\000\000\001b\000\000\000\000\002k\002[\002a\002L\002[\000\000\005\"\002]\000\000\002\b\002\t\002M\000\000\002\b\002\t\005#\000\000\005$\002\012\000\000\002_\002m\003K\002L\002[\000\000\000\000\002L\002k\000\000\002a\002M\000\000\005%\000\000\002M\000\000\001w\000\000\000\000\000\000\000\000\000\000\002b\002[\001x\000\000\001b\002[\002m\000\000\000\000\000\000\000\000\002]\000\000\005&\002]\000\000\002\b\002\t\005(\0052\000\000\000\000\002\012\000\000\000\000\002\012\000\000\002_\005\\\002\242\002L\000\000\000\000\000\000\002]\002k\000\000\002a\002M\000\000\000\000\000\000\000\000\005]\000\000\002\012\000\000\002b\000\000\000\000\002b\002[\000\000\000\000\002]\000\000\002m\000\000\002]\000\000\000\000\002\b\002\t\000\000\000\000\002\012\002\b\002\t\000\000\002\012\002b\000\000\000\000\000\000\002_\002L\002g\002_\000\000\002i\002L\000\000\002k\002M\002a\002k\000\000\002a\002M\000\000\002b\000\000\000\000\000\000\002b\000\000\002[\002_\000\000\002n\000\000\002[\000\000\002m\002]\002k\002m\002a\000\000\000\000\002\b\002\t\000\000\000\000\000\000\002\012\000\000\002_\000\000\002u\000\000\002_\000\000\002w\002L\002k\002m\002a\000\000\002k\000\000\002a\002M\002\b\002\t\000\000\000\000\000\000\000\000\000\000\002b\000\000\000\000\000\000\000\000\002[\002m\002L\000\000\002]\002m\000\000\000\000\000\000\002]\002M\002\b\002\t\000\000\000\000\002\012\000\000\000\000\000\000\000\000\002\012\000\000\002_\002[\002y\002L\000\000\000\000\000\000\000\000\002k\000\000\002a\002M\000\000\002\b\002\t\000\000\000\000\000\000\002b\000\000\000\000\000\000\000\000\002b\002[\000\000\000\000\002L\000\000\002m\000\000\002]\000\000\000\000\000\000\002M\000\000\000\000\000\000\000\000\000\000\000\000\002\012\000\000\000\000\002_\000\000\002{\002[\000\000\002_\000\000\002}\002k\002]\002a\002\b\002\t\002k\000\000\002a\000\000\000\000\000\000\000\000\002\012\000\000\002b\000\000\000\000\002L\002\b\002\t\000\000\002m\000\000\000\000\002]\002M\002m\000\000\000\000\000\000\000\000\000\000\002L\000\000\000\000\002\012\000\000\002b\002[\000\000\002M\002_\000\000\002\127\000\000\000\000\000\000\000\000\002]\002k\000\000\002a\000\000\002[\000\000\000\000\000\000\000\000\000\000\002\012\002b\002\b\002\t\000\000\002_\000\000\002\129\000\000\000\000\000\000\002m\000\000\002k\000\000\002a\002L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002M\002b\002\b\002\t\002_\000\000\002\131\000\000\002]\000\000\002m\000\000\002k\002[\002a\000\000\002L\002\b\002\t\002\012\000\000\000\000\000\000\002]\002M\006\016\002\b\002\t\002_\000\000\002\133\002L\000\000\002m\002\012\000\000\002k\002[\002a\002M\002L\000\000\006\017\000\000\002b\006\019\000\000\000\000\002M\000\000\002\b\002\t\002[\000\000\006\020\000\000\000\000\002m\000\000\002b\000\000\002[\000\000\000\000\002L\000\000\002]\000\000\000\000\000\000\000\000\002_\002M\002\135\000\000\000\000\000\000\002\012\000\000\002k\000\000\002a\000\000\006\021\000\000\002[\002_\000\000\002\137\000\000\002]\000\000\000\000\000\000\002k\000\000\002a\000\000\000\000\000\000\002m\002\012\002b\000\000\000\000\002]\000\000\000\000\002\b\002\t\000\000\006\022\000\000\000\000\002]\002m\002\012\000\000\000\000\006\023\000\000\000\000\002L\000\000\000\000\002\012\002b\000\000\000\000\002_\002M\002\139\002\b\002\t\000\000\000\000\006\024\002k\002]\002a\000\000\002b\000\000\002[\000\000\000\000\002L\000\000\000\000\002\012\002b\006\025\000\000\002_\002M\002\141\000\000\000\000\002m\000\000\006\026\002k\000\000\002a\000\000\006\028\000\000\002[\002_\000\000\002\143\000\000\000\000\000\000\002b\006\030\002k\002_\002a\002\145\002\b\002\t\002m\000\000\000\000\002k\000\000\002a\000\000\000\000\006\031\000\000\000\000\000\000\002L\000\000\002]\002m\000\000\000\000\000\000\002_\002M\002\147\002\b\002\t\002m\002\012\000\000\002k\000\000\002a\000\000\000\000\000\000\002[\000\000\000\000\002L\000\000\002]\000\000\001[\000\000\000\000\001\014\002M\000\000\001\015\000\000\002m\002\012\002b\000\000\000\000\000\000\000\000\001\014\000\000\002[\005\005\001\\\001l\000\000\001^\001_\000\000\000\000\000\000\000\000\000\000\001[\001\017\000\000\000\000\000\000\002b\000\000\000\000\002_\000\000\002\149\004\187\000\000\001\017\000\000\000\000\002k\002]\002a\001\\\001l\000\000\001^\001_\000\000\000\000\005\149\000\000\002\012\000\000\000\000\000\000\002_\001m\002\151\001n\002\222\002m\001!\000\000\002k\002]\002a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\007\001[\002\012\002b\002\b\002\t\000\000\000\000\001u\000\000\000\000\002m\001m\000\000\001n\002\225\000\000\001\019\002L\001d\001\\\001l\001[\001^\001_\000\000\002M\002b\000\000\005\n\002_\000\000\002\153\000\000\000\000\002\b\002\t\001u\002k\002[\002a\001\\\001l\000\000\001^\001_\000\000\000\000\001d\000\000\000\000\000\000\000\000\000\000\002_\000\000\002\155\002I\000\000\002m\000\000\0015\002k\001m\002a\001n\002\228\000\000\001\028\000\000\000\000\001w\004\192\000\000\000\000\000\000\002\b\002\t\000\000\001x\005\r\001b\000\000\002m\001m\000\000\001n\002\236\001u\000\000\002L\004\213\002]\005\018\001%\005\015\001?\000\000\002M\001d\001w\000\000\000\000\002\012\002\b\002\t\001%\000\000\001x\001u\001b\002[\000\000\000\000\000\000\000\000\000\000\000\000\002L\000\000\001d\002\b\002\t\002\011\000\000\000\000\002M\000\000\002b\000\000\000\000\000\000\000\000\000\000\002\012\002L\000\000\000\000\000\000\002[\000\000\000\000\000\000\002M\002\b\002\t\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\000\000\002_\002[\002\248\002L\001x\000\000\001b\000\000\002k\002]\002a\002M\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\002\012\002\b\002\t\000\000\002[\001x\000\000\001b\000\000\002m\000\000\002_\000\000\002\b\002\t\002L\000\000\002]\000\000\002`\000\000\002a\000\000\002M\000\000\002b\000\000\002L\002\012\000\000\000\000\000\000\000\000\000\000\002]\002M\002[\000\000\000\000\000\000\001\014\002\b\002\t\005\005\000\000\002\012\000\000\000\000\002[\000\000\000\000\000\000\002_\002b\003\021\002L\000\000\002]\000\000\000\000\002k\000\000\002a\002M\000\000\000\000\000\000\001\017\002\012\000\000\002b\000\000\000\000\000\000\000\000\000\000\002[\000\000\000\000\000\000\002_\002m\003\027\000\000\000\000\000\000\000\000\000\000\002k\002]\002a\000\000\000\000\002b\000\000\000\000\000\000\002_\000\000\003 \002\012\002]\000\000\000\000\005\007\002k\000\000\002a\000\000\002m\002\b\002\t\002\012\002\b\002\t\000\000\000\000\000\000\000\000\000\000\002_\000\000\003(\000\000\002L\002b\002m\002L\002k\002]\002a\000\000\002M\005\n\000\000\002M\000\000\002b\000\000\000\000\002\012\002\b\002\t\000\000\000\000\002[\000\000\000\000\002[\002m\000\000\000\000\002_\000\000\003-\002L\002\b\002\t\000\000\000\000\002k\000\000\002a\002M\002_\002b\003/\000\000\000\000\000\000\002L\000\000\002k\000\000\002a\000\000\002[\000\000\002M\000\000\000\000\002m\002\b\002\t\005\r\000\000\000\000\000\000\000\000\002\b\002\t\002[\002_\002m\0032\004\213\002L\005\017\002]\005\015\002k\002]\002a\002L\002M\000\000\000\000\000\000\000\000\002\012\001%\002M\002\012\002\b\002\t\000\000\000\000\002[\000\000\000\000\000\000\002m\000\000\000\000\002[\000\000\000\000\000\000\000\000\002]\000\000\001[\000\000\000\000\002b\002S\000\000\002b\000\000\000\000\002\012\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\000\000\001\\\002\179\000\000\001^\001_\002\012\000\000\000\000\006\016\000\000\000\000\002_\000\000\0039\002_\002b\003>\000\000\000\000\002k\002]\002a\002k\000\000\002a\006\223\000\000\002]\006\019\000\000\002b\002\012\000\000\000\000\000\000\000\000\000\000\006\020\002\012\000\000\002m\006\016\002_\002m\003C\000\000\000\000\000\000\000\000\000\000\002k\002\011\002a\001[\000\000\000\000\002b\002_\006\017\003F\000\000\006\019\002\012\002b\000\000\002k\006\021\002a\001c\000\000\006\020\002m\001\\\001l\000\000\001^\001_\000\000\000\000\001d\000\000\000\000\000\000\002_\006\016\003x\002m\000\000\000\000\000\000\002_\002k\003z\002a\006\022\000\000\000\000\000\000\002k\006\021\002a\006\017\006\023\000\000\006\019\000\000\003e\000\000\000\000\000\000\001[\000\000\002m\006\020\002_\001m\006\224\001n\004<\002m\000\000\000\000\002`\000\000\002a\003g\000\000\006\022\000\000\001\\\002\179\001w\001^\001_\006\025\006\023\000\000\000\000\000\000\001\146\001u\001b\006\021\006\026\000\000\000\000\001[\000\000\006\028\000\000\000\000\001d\006#\000\000\000\000\000\000\000\000\000\000\006\030\000\000\001[\000\000\000\000\000\000\000\000\001\\\002\179\006\025\001^\001_\006\022\000\000\000\000\006\031\000\000\000\000\006\026\000\000\006\023\001\\\002\179\006\028\001^\001_\000\000\000\000\000\000\000\000\000\000\001\014\000\000\006\030\001\015\000\000\000\000\006,\000\000\001c\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\006\031\000\000\001d\001\014\006\025\001x\001\015\001b\000\000\000\000\001\017\000\000\000\000\006\026\000\000\000\000\000\000\000\000\006\028\000\000\004\187\000\000\000\000\000\000\000\000\000\000\000\000\001c\006\030\003e\001\017\000\000\000\000\000\000\000\000\005\163\000\000\001[\001d\000\000\004\187\001c\000\000\006\031\000\000\000\000\000\000\001!\003f\000\000\000\000\001[\001d\005\176\001w\005\173\001\\\002\179\001[\001^\001_\000\000\001\146\000\000\001b\003e\001\014\001!\000\000\001\015\001\\\002\179\000\000\001^\001_\000\000\001\019\001\\\002\179\006\003\001^\001_\000\000\000\000\003j\000\000\000\000\001[\000\000\000\000\001w\000\000\000\000\001\017\000\000\000\000\001\019\000\000\001\146\000\000\001b\000\000\000\000\003\226\001w\000\000\001\\\002\179\000\000\001^\001_\000\000\001\146\000\000\001b\000\000\000\000\006x\000\000\000\000\0015\000\000\000\000\000\000\001c\006\005\000\000\001\028\000\000\000\000\001!\004\192\000\000\000\000\000\000\001d\000\000\000\000\001c\000\000\0015\000\000\000\000\000\000\001[\001c\000\000\001\028\000\000\001d\000\000\004\192\000\000\001%\000\000\001?\001d\000\000\000\000\001\019\000\000\000\000\002\180\001\\\002\179\000\000\001^\001_\000\000\000\000\001[\000\000\000\000\001%\001c\001?\005\203\000\000\002\b\002\t\000\000\000\000\000\000\005\203\000\000\001d\000\000\001w\001\014\001\\\002\179\001\015\001^\001_\000\000\001\146\001\014\001b\000\000\001\015\003\152\001w\000\000\0015\000\000\000\000\000\000\003\161\001w\001\146\001\028\001b\006\003\000\000\000\000\001\017\001\146\000\000\001b\001\014\000\000\005\216\001\015\001\017\000\000\003\226\000\000\000\000\005\215\000\000\003\162\001c\000\000\000\000\000\000\000\000\001%\001w\003\233\003\229\000\000\000\000\001d\002\b\002\t\001\146\001\017\001b\000\000\000\000\000\000\004\203\001!\001\014\000\000\000\000\001\015\001c\006\004\001\014\001!\000\000\001\015\000\000\000\000\002^\002\011\000\000\001d\006\003\000\000\001\014\001\014\000\000\001\015\001\015\000\000\003\165\000\000\000\000\001\017\001\019\000\000\001!\000\000\005\198\001\017\000\000\001[\001\019\000\000\000\000\000\000\000\000\001w\003i\000\000\000\000\001\017\001\017\000\000\000\000\001\146\000\000\001b\000\000\003\155\001\\\001]\000\000\001^\001_\001\019\000\000\000\000\006\012\000\000\001!\001\014\000\000\001w\001\015\000\000\001!\001\014\0015\000\000\001\015\001\146\002_\001b\002\011\001\028\0015\000\000\001!\001!\002`\000\000\002a\001\028\000\000\002\012\000\000\004\224\001\017\001\019\004\227\000\000\000\000\000\000\001\017\001\019\000\000\001\014\000\000\0015\001\015\001%\000\000\003\233\000\000\000\000\001\028\001\019\001\019\001%\004\211\001?\000\000\000\000\001\014\000\000\000\000\001\015\001c\000\000\000\000\000\000\000\000\000\000\001\017\001!\000\000\000\000\000\000\001d\000\000\001!\001%\0015\001?\000\000\000\000\002_\000\000\0015\001\028\001\017\000\000\000\000\004\211\002`\001\028\002a\000\000\000\000\004\224\0015\0015\005\244\001\019\000\000\000\000\000\000\001\028\001\028\001\019\001!\006\181\001O\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\001!\001\014\000\000\001w\001\015\000\000\001%\001%\001?\001?\000\000\001\146\001\019\001b\001\014\000\000\001[\001\015\000\000\001\014\0015\000\000\001\015\000\000\000\000\000\000\0015\001\028\001\017\001\019\000\000\001\163\000\000\001\028\000\000\001\\\002\164\001\201\001^\001_\000\000\001\017\000\000\000\000\000\000\000\000\001\017\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\001?\0015\000\000\000\000\001%\000\000\001?\000\000\001\028\000\000\001!\001\014\001\203\000\000\001\015\000\000\001\014\001\014\0015\001\015\001\015\000\000\000\000\001!\000\000\001\028\000\000\000\000\001!\002\031\000\000\000\000\000\000\000\000\001%\000\000\001?\000\000\001\017\001\019\000\000\000\000\000\000\001\017\001\017\000\000\000\000\000\000\001c\000\000\000\000\001%\001\019\001?\000\000\000\000\000\000\001\019\001\014\001d\000\000\001\015\000\000\000\000\001\014\000\000\000\000\001\015\000\000\000\000\000\000\000\000\000\000\001\014\000\000\001!\001\015\000\000\000\000\001\014\001!\001!\001\015\0015\000\000\001\017\000\000\000\000\000\000\000\000\001\028\001\017\000\000\000\000\0022\000\000\0015\000\000\000\000\000\000\001\017\0015\000\000\001\028\001\019\000\000\001\017\002\169\001\028\001\019\001\019\001w\002\174\000\000\001\014\000\000\001%\005\005\001?\001\146\001\014\001b\001!\001\015\000\000\000\000\000\000\000\000\001!\001%\000\000\001?\000\000\000\000\001%\000\000\001?\001!\000\000\000\000\000\000\001\017\000\000\001!\000\000\000\000\000\000\001\017\0015\000\000\000\000\001\019\000\000\0015\0015\001\028\000\000\001\019\000\000\002\191\001\028\001\028\000\000\000\000\002\198\002\205\001\019\001\014\000\000\000\000\001\015\000\000\001\019\001\014\000\000\000\000\001\015\000\000\005\007\000\000\000\000\001%\001\014\001?\001!\001\015\001%\001%\001?\001?\000\000\000\000\000\000\000\000\001\017\0015\000\000\000\000\000\000\000\000\001\017\0015\001\028\000\000\000\000\000\000\002\214\005\n\001\028\001\017\0015\000\000\004K\001\019\000\000\001\014\0015\001\028\005\005\000\000\000\000\004\164\000\000\001\028\000\000\000\000\000\000\004\176\001%\001\014\001?\001!\005\005\000\000\001%\000\000\001?\001!\000\000\000\000\000\000\000\000\001\017\001%\000\000\001?\001!\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\000\000\001\017\0015\005\r\000\000\001\019\000\000\000\000\000\000\001\028\000\000\001\019\001\014\004\189\004\213\001\015\005\016\000\000\005\015\000\000\001\019\000\000\002\b\002\t\005\007\000\000\000\000\001\014\000\000\001%\001\015\000\000\000\000\000\000\000\000\001%\000\000\001?\005\007\001\017\000\000\000\000\000\000\000\000\002l\000\000\000\000\002\b\002\t\0015\000\000\000\000\000\000\005\n\001\017\0015\001\028\000\000\001\014\000\000\004\210\005\005\001\028\000\000\0015\000\000\004\226\005\n\000\000\003G\000\000\001\028\000\000\000\000\001\014\005\128\001!\005\005\000\000\000\000\000\000\000\000\001%\000\000\001?\001\017\001\014\000\000\001%\001\015\001?\001!\000\000\005\209\000\000\000\000\000\000\001%\000\000\001?\000\000\001\017\002\b\002\t\005\r\001\019\000\000\000\000\000\000\000\000\002\011\000\000\000\000\001\017\000\000\004\213\000\000\005\014\005\r\005\015\001\019\002\012\005\007\000\000\003\014\000\000\000\000\000\000\000\000\004\213\001%\005\026\000\000\005\015\000\000\002\011\000\000\000\000\005\007\001\014\000\000\000\000\001\015\000\000\001%\001\014\002\012\000\000\001\015\0015\001!\005\n\000\000\000\000\000\000\000\000\001\028\000\000\001\014\000\000\005\146\001\015\001\014\000\000\0015\001\015\001\017\005\n\000\000\000\000\000\000\001\028\001\017\002_\003J\005\170\000\000\000\000\000\000\001\019\000\000\002`\001%\002a\001?\001\017\000\000\000\000\000\000\001\017\002\011\000\000\000\000\000\000\000\000\000\000\000\000\001%\002_\001?\000\000\002\012\005\r\001!\000\000\000\000\002`\000\000\002a\001!\000\000\000\000\000\000\004\213\000\000\005\230\000\000\005\015\005\r\000\000\000\000\000\000\001!\0015\000\000\000\000\001!\000\000\001%\004\213\001\028\006\000\001\019\005\015\0068\000\000\000\000\000\000\001\019\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\001\019\000\000\002_\000\000\001\019\001%\000\000\001?\000\000\000\000\002`\000\000\002a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0015\000\000\000\000\000\000\000\000\000\000\0015\001\028\000\000\000\000\000\000\006\141\000\000\001\028\000\000\000\000\000\000\006\145\000\000\0015\000\000\000\000\000\000\0015\000\000\000\000\001\028\000\000\000\000\000\000\001\028\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\001\198\000\000\001%\000\000\003\228"))
and semantic_action =
[|
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3552 "parsing/parser.mly"
+# 3579 "parsing/parser.mly"
( "+" )
-# 1293 "parsing/parser.ml"
+# 1315 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3553 "parsing/parser.mly"
+# 3580 "parsing/parser.mly"
( "+." )
-# 1318 "parsing/parser.ml"
+# 1340 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3125 "parsing/parser.mly"
+# 3148 "parsing/parser.mly"
( _1 )
-# 1343 "parsing/parser.ml"
+# 1365 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3128 "parsing/parser.mly"
+# 3151 "parsing/parser.mly"
( Ptyp_alias(ty, tyvar) )
-# 1390 "parsing/parser.ml"
+# 1412 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_tyvar_, _startpos_ty_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1399 "parsing/parser.ml"
+# 1421 "parsing/parser.ml"
in
-# 3130 "parsing/parser.mly"
+# 3153 "parsing/parser.mly"
( _1 )
-# 1405 "parsing/parser.ml"
+# 1427 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (let_binding) = let attrs2 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 1453 "parsing/parser.ml"
+# 1475 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 1462 "parsing/parser.ml"
+# 1484 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2405 "parsing/parser.mly"
+# 2428 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklb ~loc:_sloc false body attrs
)
-# 1474 "parsing/parser.ml"
+# 1496 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 3186 "parsing/parser.mly"
+# 3209 "parsing/parser.mly"
( _2 )
-# 1513 "parsing/parser.ml"
+# 1535 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 1576 "parsing/parser.ml"
+# 1598 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1584 "parsing/parser.ml"
+# 1606 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 1590 "parsing/parser.ml"
+# 1612 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 1600 "parsing/parser.ml"
+# 1622 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 1606 "parsing/parser.ml"
+# 1628 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3188 "parsing/parser.mly"
+# 3211 "parsing/parser.mly"
( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 )
-# 1615 "parsing/parser.ml"
+# 1637 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3191 "parsing/parser.mly"
+# 3214 "parsing/parser.mly"
( Ptyp_var _2 )
-# 1648 "parsing/parser.ml"
+# 1670 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1657 "parsing/parser.ml"
+# 1679 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 1663 "parsing/parser.ml"
+# 1685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3193 "parsing/parser.mly"
+# 3216 "parsing/parser.mly"
( Ptyp_any )
-# 1689 "parsing/parser.ml"
+# 1711 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1697 "parsing/parser.ml"
+# 1719 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 1703 "parsing/parser.ml"
+# 1725 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1734 "parsing/parser.ml"
+# 1756 "parsing/parser.ml"
in
let tys =
-# 3238 "parsing/parser.mly"
+# 3261 "parsing/parser.mly"
( [] )
-# 1740 "parsing/parser.ml"
+# 1762 "parsing/parser.ml"
in
-# 3196 "parsing/parser.mly"
+# 3219 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1745 "parsing/parser.ml"
+# 1767 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1754 "parsing/parser.ml"
+# 1776 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 1760 "parsing/parser.ml"
+# 1782 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1798 "parsing/parser.ml"
+# 1820 "parsing/parser.ml"
in
let tys =
-# 3240 "parsing/parser.mly"
+# 3263 "parsing/parser.mly"
( [ty] )
-# 1804 "parsing/parser.ml"
+# 1826 "parsing/parser.ml"
in
-# 3196 "parsing/parser.mly"
+# 3219 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1809 "parsing/parser.ml"
+# 1831 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_ty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1819 "parsing/parser.ml"
+# 1841 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 1825 "parsing/parser.ml"
+# 1847 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1878 "parsing/parser.ml"
+# 1900 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 1886 "parsing/parser.ml"
+# 1908 "parsing/parser.ml"
in
-# 932 "parsing/parser.mly"
+# 954 "parsing/parser.mly"
( xs )
-# 1891 "parsing/parser.ml"
+# 1913 "parsing/parser.ml"
in
-# 3242 "parsing/parser.mly"
+# 3265 "parsing/parser.mly"
( tys )
-# 1897 "parsing/parser.ml"
+# 1919 "parsing/parser.ml"
in
-# 3196 "parsing/parser.mly"
+# 3219 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1903 "parsing/parser.ml"
+# 1925 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1913 "parsing/parser.ml"
+# 1935 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 1919 "parsing/parser.ml"
+# 1941 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3198 "parsing/parser.mly"
+# 3221 "parsing/parser.mly"
( let (f, c) = _2 in Ptyp_object (f, c) )
-# 1959 "parsing/parser.ml"
+# 1981 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1968 "parsing/parser.ml"
+# 1990 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 1974 "parsing/parser.ml"
+# 1996 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3200 "parsing/parser.mly"
+# 3223 "parsing/parser.mly"
( Ptyp_object ([], Closed) )
-# 2007 "parsing/parser.ml"
+# 2029 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2016 "parsing/parser.ml"
+# 2038 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2022 "parsing/parser.ml"
+# 2044 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2060 "parsing/parser.ml"
+# 2082 "parsing/parser.ml"
in
let tys =
-# 3238 "parsing/parser.mly"
+# 3261 "parsing/parser.mly"
( [] )
-# 2066 "parsing/parser.ml"
+# 2088 "parsing/parser.ml"
in
-# 3204 "parsing/parser.mly"
+# 3227 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2071 "parsing/parser.ml"
+# 2093 "parsing/parser.ml"
in
let _startpos__1_ = _startpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2081 "parsing/parser.ml"
+# 2103 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2087 "parsing/parser.ml"
+# 2109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2132 "parsing/parser.ml"
+# 2154 "parsing/parser.ml"
in
let tys =
-# 3240 "parsing/parser.mly"
+# 3263 "parsing/parser.mly"
( [ty] )
-# 2138 "parsing/parser.ml"
+# 2160 "parsing/parser.ml"
in
-# 3204 "parsing/parser.mly"
+# 3227 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2143 "parsing/parser.ml"
+# 2165 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_ty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2153 "parsing/parser.ml"
+# 2175 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2159 "parsing/parser.ml"
+# 2181 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2219 "parsing/parser.ml"
+# 2241 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2227 "parsing/parser.ml"
+# 2249 "parsing/parser.ml"
in
-# 932 "parsing/parser.mly"
+# 954 "parsing/parser.mly"
( xs )
-# 2232 "parsing/parser.ml"
+# 2254 "parsing/parser.ml"
in
-# 3242 "parsing/parser.mly"
+# 3265 "parsing/parser.mly"
( tys )
-# 2238 "parsing/parser.ml"
+# 2260 "parsing/parser.ml"
in
-# 3204 "parsing/parser.mly"
+# 3227 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2244 "parsing/parser.ml"
+# 2266 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2254 "parsing/parser.ml"
+# 2276 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2260 "parsing/parser.ml"
+# 2282 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3207 "parsing/parser.mly"
+# 3230 "parsing/parser.mly"
( Ptyp_variant([_2], Closed, None) )
-# 2300 "parsing/parser.ml"
+# 2322 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2309 "parsing/parser.ml"
+# 2331 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2315 "parsing/parser.ml"
+# 2337 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2365 "parsing/parser.ml"
+# 2387 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 2370 "parsing/parser.ml"
+# 2392 "parsing/parser.ml"
in
-# 3252 "parsing/parser.mly"
+# 3275 "parsing/parser.mly"
( _1 )
-# 2376 "parsing/parser.ml"
+# 2398 "parsing/parser.ml"
in
-# 3209 "parsing/parser.mly"
+# 3232 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, None) )
-# 2382 "parsing/parser.ml"
+# 2404 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2392 "parsing/parser.ml"
+# 2414 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2398 "parsing/parser.ml"
+# 2420 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2455 "parsing/parser.ml"
+# 2477 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 2460 "parsing/parser.ml"
+# 2482 "parsing/parser.ml"
in
-# 3252 "parsing/parser.mly"
+# 3275 "parsing/parser.mly"
( _1 )
-# 2466 "parsing/parser.ml"
+# 2488 "parsing/parser.ml"
in
-# 3211 "parsing/parser.mly"
+# 3234 "parsing/parser.mly"
( Ptyp_variant(_2 :: _4, Closed, None) )
-# 2472 "parsing/parser.ml"
+# 2494 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2482 "parsing/parser.ml"
+# 2504 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2488 "parsing/parser.ml"
+# 2510 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2538 "parsing/parser.ml"
+# 2560 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 2543 "parsing/parser.ml"
+# 2565 "parsing/parser.ml"
in
-# 3252 "parsing/parser.mly"
+# 3275 "parsing/parser.mly"
( _1 )
-# 2549 "parsing/parser.ml"
+# 2571 "parsing/parser.ml"
in
-# 3213 "parsing/parser.mly"
+# 3236 "parsing/parser.mly"
( Ptyp_variant(_3, Open, None) )
-# 2555 "parsing/parser.ml"
+# 2577 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2565 "parsing/parser.ml"
+# 2587 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2571 "parsing/parser.ml"
+# 2593 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3215 "parsing/parser.mly"
+# 3238 "parsing/parser.mly"
( Ptyp_variant([], Open, None) )
-# 2604 "parsing/parser.ml"
+# 2626 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2613 "parsing/parser.ml"
+# 2635 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2619 "parsing/parser.ml"
+# 2641 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2669 "parsing/parser.ml"
+# 2691 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 2674 "parsing/parser.ml"
+# 2696 "parsing/parser.ml"
in
-# 3252 "parsing/parser.mly"
+# 3275 "parsing/parser.mly"
( _1 )
-# 2680 "parsing/parser.ml"
+# 2702 "parsing/parser.ml"
in
-# 3217 "parsing/parser.mly"
+# 3240 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some []) )
-# 2686 "parsing/parser.ml"
+# 2708 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2696 "parsing/parser.ml"
+# 2718 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2702 "parsing/parser.ml"
+# 2724 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2767 "parsing/parser.ml"
+# 2789 "parsing/parser.ml"
in
-# 872 "parsing/parser.mly"
+# 894 "parsing/parser.mly"
( xs )
-# 2772 "parsing/parser.ml"
+# 2794 "parsing/parser.ml"
in
-# 3280 "parsing/parser.mly"
+# 3303 "parsing/parser.mly"
( _1 )
-# 2778 "parsing/parser.ml"
+# 2800 "parsing/parser.ml"
in
let _3 =
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 2786 "parsing/parser.ml"
+# 2808 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 2791 "parsing/parser.ml"
+# 2813 "parsing/parser.ml"
in
-# 3252 "parsing/parser.mly"
+# 3275 "parsing/parser.mly"
( _1 )
-# 2797 "parsing/parser.ml"
+# 2819 "parsing/parser.ml"
in
-# 3219 "parsing/parser.mly"
+# 3242 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some _5) )
-# 2803 "parsing/parser.ml"
+# 2825 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2813 "parsing/parser.ml"
+# 2835 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2819 "parsing/parser.ml"
+# 2841 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3221 "parsing/parser.mly"
+# 3244 "parsing/parser.mly"
( Ptyp_extension _1 )
-# 2845 "parsing/parser.ml"
+# 2867 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2853 "parsing/parser.ml"
+# 2875 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _1 )
-# 2859 "parsing/parser.ml"
+# 2881 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3619 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 2885 "parsing/parser.ml"
+# 2907 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 800 "parsing/parser.mly"
+# 822 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
-# 2893 "parsing/parser.ml"
+# 2915 "parsing/parser.ml"
in
-# 3621 "parsing/parser.mly"
+# 3648 "parsing/parser.mly"
( _1 )
-# 2899 "parsing/parser.ml"
+# 2921 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3620 "parsing/parser.mly"
+# 3647 "parsing/parser.mly"
( _1 ^ "." ^ _3.txt )
-# 2939 "parsing/parser.ml"
+# 2961 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 800 "parsing/parser.mly"
+# 822 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
-# 2948 "parsing/parser.ml"
+# 2970 "parsing/parser.ml"
in
-# 3621 "parsing/parser.mly"
+# 3648 "parsing/parser.mly"
( _1 )
-# 2954 "parsing/parser.ml"
+# 2976 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3625 "parsing/parser.mly"
+# 3652 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 3003 "parsing/parser.ml"
+# 3025 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) =
-# 1692 "parsing/parser.mly"
+# 1712 "parsing/parser.mly"
( _1 )
-# 3028 "parsing/parser.ml"
+# 3050 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3069 "parsing/parser.ml"
+# 3091 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1694 "parsing/parser.mly"
+# 1714 "parsing/parser.mly"
( wrap_class_attrs ~loc:_sloc _3 _2 )
-# 3078 "parsing/parser.ml"
+# 3100 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1696 "parsing/parser.mly"
+# 1716 "parsing/parser.mly"
( class_of_let_bindings ~loc:_sloc _1 _3 )
-# 3120 "parsing/parser.ml"
+# 3142 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 3185 "parsing/parser.ml"
+# 3207 "parsing/parser.ml"
in
let _4 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3193 "parsing/parser.ml"
+# 3215 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined1_ in
let _3 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 3200 "parsing/parser.ml"
+# 3222 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1698 "parsing/parser.mly"
+# 1718 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__4_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 3210 "parsing/parser.ml"
+# 3232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 3282 "parsing/parser.ml"
+# 3304 "parsing/parser.ml"
in
let _4 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3290 "parsing/parser.ml"
+# 3312 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 3299 "parsing/parser.ml"
+# 3321 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1698 "parsing/parser.mly"
+# 1718 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__4_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 3310 "parsing/parser.ml"
+# 3332 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1702 "parsing/parser.mly"
+# 1722 "parsing/parser.mly"
( Cl.attr _1 _2 )
-# 3342 "parsing/parser.ml"
+# 3364 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 3377 "parsing/parser.ml"
+# 3399 "parsing/parser.ml"
in
-# 872 "parsing/parser.mly"
+# 894 "parsing/parser.mly"
( xs )
-# 3382 "parsing/parser.ml"
+# 3404 "parsing/parser.ml"
in
-# 1705 "parsing/parser.mly"
+# 1725 "parsing/parser.mly"
( Pcl_apply(_1, _2) )
-# 3388 "parsing/parser.ml"
+# 3410 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3398 "parsing/parser.ml"
+# 3420 "parsing/parser.ml"
in
-# 1708 "parsing/parser.mly"
+# 1728 "parsing/parser.mly"
( _1 )
-# 3404 "parsing/parser.ml"
+# 3426 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1707 "parsing/parser.mly"
+# 1727 "parsing/parser.mly"
( Pcl_extension _1 )
-# 3430 "parsing/parser.ml"
+# 3452 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3438 "parsing/parser.ml"
+# 3460 "parsing/parser.ml"
in
-# 1708 "parsing/parser.mly"
+# 1728 "parsing/parser.mly"
( _1 )
-# 3444 "parsing/parser.ml"
+# 3466 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3499 "parsing/parser.ml"
+# 3521 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3508 "parsing/parser.ml"
+# 3530 "parsing/parser.ml"
in
let _2 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 3514 "parsing/parser.ml"
+# 3536 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1757 "parsing/parser.mly"
+# 1777 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3523 "parsing/parser.ml"
+# 3545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3585 "parsing/parser.ml"
+# 3607 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _3 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3594 "parsing/parser.ml"
+# 3616 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 3602 "parsing/parser.ml"
+# 3624 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1757 "parsing/parser.mly"
+# 1777 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3612 "parsing/parser.ml"
+# 3634 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3655 "parsing/parser.ml"
+# 3677 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1760 "parsing/parser.mly"
+# 1780 "parsing/parser.mly"
( let v, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
-# 3667 "parsing/parser.ml"
+# 3689 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3710 "parsing/parser.ml"
+# 3732 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1764 "parsing/parser.mly"
+# 1784 "parsing/parser.mly"
( let meth, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
-# 3722 "parsing/parser.ml"
+# 3744 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3770 "parsing/parser.ml"
+# 3792 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3779 "parsing/parser.ml"
+# 3801 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1768 "parsing/parser.mly"
+# 1788 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 3789 "parsing/parser.ml"
+# 3811 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3837 "parsing/parser.ml"
+# 3859 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 3846 "parsing/parser.ml"
+# 3868 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1771 "parsing/parser.mly"
+# 1791 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
-# 3856 "parsing/parser.ml"
+# 3878 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _2 =
let _1 = _1_inlined1 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 3890 "parsing/parser.ml"
+# 3912 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1774 "parsing/parser.mly"
+# 1794 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
-# 3901 "parsing/parser.ml"
+# 3923 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_field) = let _1 =
let _1 =
-# 1777 "parsing/parser.mly"
+# 1797 "parsing/parser.mly"
( Pcf_attribute _1 )
-# 3927 "parsing/parser.ml"
+# 3949 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 821 "parsing/parser.mly"
+# 843 "parsing/parser.mly"
( mkcf ~loc:_sloc _1 )
-# 3935 "parsing/parser.ml"
+# 3957 "parsing/parser.ml"
in
-# 1778 "parsing/parser.mly"
+# 1798 "parsing/parser.mly"
( _1 )
-# 3941 "parsing/parser.ml"
+# 3963 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1672 "parsing/parser.mly"
+# 1692 "parsing/parser.mly"
( _2 )
-# 3973 "parsing/parser.ml"
+# 3995 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1675 "parsing/parser.mly"
+# 1695 "parsing/parser.mly"
( Pcl_constraint(_4, _2) )
-# 4020 "parsing/parser.ml"
+# 4042 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4029 "parsing/parser.ml"
+# 4051 "parsing/parser.ml"
in
-# 1678 "parsing/parser.mly"
+# 1698 "parsing/parser.mly"
( _1 )
-# 4035 "parsing/parser.ml"
+# 4057 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1677 "parsing/parser.mly"
+# 1697 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
-# 4068 "parsing/parser.ml"
+# 4090 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4077 "parsing/parser.ml"
+# 4099 "parsing/parser.ml"
in
-# 1678 "parsing/parser.mly"
+# 1698 "parsing/parser.mly"
( _1 )
-# 4083 "parsing/parser.ml"
+# 4105 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1733 "parsing/parser.mly"
+# 1753 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4123 "parsing/parser.ml"
+# 4145 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_e_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4132 "parsing/parser.ml"
+# 4154 "parsing/parser.ml"
in
-# 1734 "parsing/parser.mly"
+# 1754 "parsing/parser.mly"
( _1 )
-# 4138 "parsing/parser.ml"
+# 4160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1733 "parsing/parser.mly"
+# 1753 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4171 "parsing/parser.ml"
+# 4193 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_e_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4180 "parsing/parser.ml"
+# 4202 "parsing/parser.ml"
in
-# 1734 "parsing/parser.mly"
+# 1754 "parsing/parser.mly"
( _1 )
-# 4186 "parsing/parser.ml"
+# 4208 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 4207 "parsing/parser.ml"
+# 4229 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3439 "parsing/parser.mly"
+# 3466 "parsing/parser.mly"
( Lident _1 )
-# 4215 "parsing/parser.ml"
+# 4237 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 4248 "parsing/parser.ml"
+# 4270 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3440 "parsing/parser.mly"
+# 3467 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 4258 "parsing/parser.ml"
+# 4280 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1742 "parsing/parser.mly"
+# 1762 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 4300 "parsing/parser.ml"
+# 4322 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 1744 "parsing/parser.mly"
+# 1764 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 4354 "parsing/parser.ml"
+# 4376 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 4363 "parsing/parser.ml"
+# 4385 "parsing/parser.ml"
in
-# 1745 "parsing/parser.mly"
+# 1765 "parsing/parser.mly"
( _1 )
-# 4369 "parsing/parser.ml"
+# 4391 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 1747 "parsing/parser.mly"
+# 1767 "parsing/parser.mly"
( ghpat ~loc:_sloc Ppat_any )
-# 4390 "parsing/parser.ml"
+# 4412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 1872 "parsing/parser.mly"
+# 1892 "parsing/parser.mly"
( _2 )
-# 4429 "parsing/parser.ml"
+# 4451 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _startpos in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 1873 "parsing/parser.mly"
+# 1893 "parsing/parser.mly"
( Ptyp_any )
-# 4448 "parsing/parser.ml"
+# 4470 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__0_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 4457 "parsing/parser.ml"
+# 4479 "parsing/parser.ml"
in
-# 1874 "parsing/parser.mly"
+# 1894 "parsing/parser.mly"
( _1 )
-# 4463 "parsing/parser.ml"
+# 4485 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 4511 "parsing/parser.ml"
+# 4533 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 4520 "parsing/parser.ml"
+# 4542 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1882 "parsing/parser.mly"
+# 1902 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
-# 4530 "parsing/parser.ml"
+# 4552 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty : (Parsetree.core_type) = Obj.magic ty in
let _3 : unit = Obj.magic _3 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 4590 "parsing/parser.ml"
+# 4612 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let flags : (Asttypes.mutable_flag * Asttypes.virtual_flag) = Obj.magic flags in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 4603 "parsing/parser.ml"
+# 4625 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined3_ in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let label =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 4613 "parsing/parser.ml"
+# 4635 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4621 "parsing/parser.ml"
+# 4643 "parsing/parser.ml"
in
-# 1907 "parsing/parser.mly"
+# 1927 "parsing/parser.mly"
(
let mut, virt = flags in
label, mut, virt, ty
)
-# 4630 "parsing/parser.ml"
+# 4652 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 4638 "parsing/parser.ml"
+# 4660 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1885 "parsing/parser.mly"
+# 1905 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
-# 4648 "parsing/parser.ml"
+# 4670 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 4708 "parsing/parser.ml"
+# 4730 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag * Asttypes.virtual_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _v : (Parsetree.class_type_field) = let _7 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 4721 "parsing/parser.ml"
+# 4743 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _6 =
let _1 = _1_inlined3 in
-# 3091 "parsing/parser.mly"
+# 3114 "parsing/parser.mly"
( _1 )
-# 4730 "parsing/parser.ml"
+# 4752 "parsing/parser.ml"
in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 4738 "parsing/parser.ml"
+# 4760 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4746 "parsing/parser.ml"
+# 4768 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 4754 "parsing/parser.ml"
+# 4776 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1889 "parsing/parser.mly"
+# 1909 "parsing/parser.mly"
( let (p, v) = _3 in
let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_method (_4, p, v, _6)) ~attrs:(_2@_7) ~docs )
-# 4765 "parsing/parser.ml"
+# 4787 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 4813 "parsing/parser.ml"
+# 4835 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 4822 "parsing/parser.ml"
+# 4844 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1893 "parsing/parser.mly"
+# 1913 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 4832 "parsing/parser.ml"
+# 4854 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _2 =
let _1 = _1_inlined1 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 4866 "parsing/parser.ml"
+# 4888 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1896 "parsing/parser.mly"
+# 1916 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
-# 4877 "parsing/parser.ml"
+# 4899 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type_field) = let _1 =
let _1 =
-# 1899 "parsing/parser.mly"
+# 1919 "parsing/parser.mly"
( Pctf_attribute _1 )
-# 4903 "parsing/parser.ml"
+# 4925 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 819 "parsing/parser.mly"
+# 841 "parsing/parser.mly"
( mkctf ~loc:_sloc _1 )
-# 4911 "parsing/parser.ml"
+# 4933 "parsing/parser.ml"
in
-# 1900 "parsing/parser.mly"
+# 1920 "parsing/parser.mly"
( _1 )
-# 4917 "parsing/parser.ml"
+# 4939 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4948 "parsing/parser.ml"
+# 4970 "parsing/parser.ml"
in
let tys =
let tys =
-# 1858 "parsing/parser.mly"
+# 1878 "parsing/parser.mly"
( [] )
-# 4955 "parsing/parser.ml"
+# 4977 "parsing/parser.ml"
in
-# 1864 "parsing/parser.mly"
+# 1884 "parsing/parser.mly"
( tys )
-# 4960 "parsing/parser.ml"
+# 4982 "parsing/parser.ml"
in
-# 1841 "parsing/parser.mly"
+# 1861 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 4966 "parsing/parser.ml"
+# 4988 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 4975 "parsing/parser.ml"
+# 4997 "parsing/parser.ml"
in
-# 1844 "parsing/parser.mly"
+# 1864 "parsing/parser.mly"
( _1 )
-# 4981 "parsing/parser.ml"
+# 5003 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5034 "parsing/parser.ml"
+# 5056 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 5043 "parsing/parser.ml"
+# 5065 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 5048 "parsing/parser.ml"
+# 5070 "parsing/parser.ml"
in
-# 1860 "parsing/parser.mly"
+# 1880 "parsing/parser.mly"
( params )
-# 5054 "parsing/parser.ml"
+# 5076 "parsing/parser.ml"
in
-# 1864 "parsing/parser.mly"
+# 1884 "parsing/parser.mly"
( tys )
-# 5060 "parsing/parser.ml"
+# 5082 "parsing/parser.ml"
in
-# 1841 "parsing/parser.mly"
+# 1861 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5066 "parsing/parser.ml"
+# 5088 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5076 "parsing/parser.ml"
+# 5098 "parsing/parser.ml"
in
-# 1844 "parsing/parser.mly"
+# 1864 "parsing/parser.mly"
( _1 )
-# 5082 "parsing/parser.ml"
+# 5104 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
-# 1843 "parsing/parser.mly"
+# 1863 "parsing/parser.mly"
( Pcty_extension _1 )
-# 5108 "parsing/parser.ml"
+# 5130 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5116 "parsing/parser.ml"
+# 5138 "parsing/parser.ml"
in
-# 1844 "parsing/parser.mly"
+# 1864 "parsing/parser.mly"
( _1 )
-# 5122 "parsing/parser.ml"
+# 5144 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 5179 "parsing/parser.ml"
+# 5201 "parsing/parser.ml"
in
-# 1878 "parsing/parser.mly"
+# 1898 "parsing/parser.mly"
( _1 )
-# 5184 "parsing/parser.ml"
+# 5206 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 765 "parsing/parser.mly"
+# 787 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5193 "parsing/parser.ml"
+# 5215 "parsing/parser.ml"
in
-# 1868 "parsing/parser.mly"
+# 1888 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5199 "parsing/parser.ml"
+# 5221 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 5207 "parsing/parser.ml"
+# 5229 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1846 "parsing/parser.mly"
+# 1866 "parsing/parser.mly"
( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
-# 5216 "parsing/parser.ml"
+# 5238 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 5273 "parsing/parser.ml"
+# 5295 "parsing/parser.ml"
in
-# 1878 "parsing/parser.mly"
+# 1898 "parsing/parser.mly"
( _1 )
-# 5278 "parsing/parser.ml"
+# 5300 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 765 "parsing/parser.mly"
+# 787 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5287 "parsing/parser.ml"
+# 5309 "parsing/parser.ml"
in
-# 1868 "parsing/parser.mly"
+# 1888 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5293 "parsing/parser.ml"
+# 5315 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 5301 "parsing/parser.ml"
+# 5323 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1848 "parsing/parser.mly"
+# 1868 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5309 "parsing/parser.ml"
+# 5331 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_type) =
-# 1850 "parsing/parser.mly"
+# 1870 "parsing/parser.mly"
( Cty.attr _1 _2 )
-# 5341 "parsing/parser.ml"
+# 5363 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5406 "parsing/parser.ml"
+# 5428 "parsing/parser.ml"
in
let _4 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 5414 "parsing/parser.ml"
+# 5436 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined1_ in
let _3 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 5421 "parsing/parser.ml"
+# 5443 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1852 "parsing/parser.mly"
+# 1872 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__4_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 5431 "parsing/parser.ml"
+# 5453 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5503 "parsing/parser.ml"
+# 5525 "parsing/parser.ml"
in
let _4 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 5511 "parsing/parser.ml"
+# 5533 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 5520 "parsing/parser.ml"
+# 5542 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1852 "parsing/parser.mly"
+# 1872 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__4_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 5531 "parsing/parser.ml"
+# 5553 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.class_expr) =
-# 1712 "parsing/parser.mly"
+# 1732 "parsing/parser.mly"
( _2 )
-# 5570 "parsing/parser.ml"
+# 5592 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1714 "parsing/parser.mly"
+# 1734 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 5611 "parsing/parser.ml"
+# 5633 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5642 "parsing/parser.ml"
+# 5664 "parsing/parser.ml"
in
let tys =
let tys =
-# 1858 "parsing/parser.mly"
+# 1878 "parsing/parser.mly"
( [] )
-# 5649 "parsing/parser.ml"
+# 5671 "parsing/parser.ml"
in
-# 1864 "parsing/parser.mly"
+# 1884 "parsing/parser.mly"
( tys )
-# 5654 "parsing/parser.ml"
+# 5676 "parsing/parser.ml"
in
-# 1717 "parsing/parser.mly"
+# 1737 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5660 "parsing/parser.ml"
+# 5682 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5669 "parsing/parser.ml"
+# 5691 "parsing/parser.ml"
in
-# 1724 "parsing/parser.mly"
+# 1744 "parsing/parser.mly"
( _1 )
-# 5675 "parsing/parser.ml"
+# 5697 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5728 "parsing/parser.ml"
+# 5750 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 5737 "parsing/parser.ml"
+# 5759 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 5742 "parsing/parser.ml"
+# 5764 "parsing/parser.ml"
in
-# 1860 "parsing/parser.mly"
+# 1880 "parsing/parser.mly"
( params )
-# 5748 "parsing/parser.ml"
+# 5770 "parsing/parser.ml"
in
-# 1864 "parsing/parser.mly"
+# 1884 "parsing/parser.mly"
( tys )
-# 5754 "parsing/parser.ml"
+# 5776 "parsing/parser.ml"
in
-# 1717 "parsing/parser.mly"
+# 1737 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5760 "parsing/parser.ml"
+# 5782 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5770 "parsing/parser.ml"
+# 5792 "parsing/parser.ml"
in
-# 1724 "parsing/parser.mly"
+# 1744 "parsing/parser.mly"
( _1 )
-# 5776 "parsing/parser.ml"
+# 5798 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 5835 "parsing/parser.ml"
+# 5857 "parsing/parser.ml"
in
-# 1751 "parsing/parser.mly"
+# 1771 "parsing/parser.mly"
( _1 )
-# 5840 "parsing/parser.ml"
+# 5862 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 764 "parsing/parser.mly"
+# 786 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 5849 "parsing/parser.ml"
+# 5871 "parsing/parser.ml"
in
-# 1738 "parsing/parser.mly"
+# 1758 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 5855 "parsing/parser.ml"
+# 5877 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 5863 "parsing/parser.ml"
+# 5885 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1719 "parsing/parser.mly"
+# 1739 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5871 "parsing/parser.ml"
+# 5893 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5881 "parsing/parser.ml"
+# 5903 "parsing/parser.ml"
in
-# 1724 "parsing/parser.mly"
+# 1744 "parsing/parser.mly"
( _1 )
-# 5887 "parsing/parser.ml"
+# 5909 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1721 "parsing/parser.mly"
+# 1741 "parsing/parser.mly"
( Pcl_constraint(_2, _4) )
-# 5941 "parsing/parser.ml"
+# 5963 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5950 "parsing/parser.ml"
+# 5972 "parsing/parser.ml"
in
-# 1724 "parsing/parser.mly"
+# 1744 "parsing/parser.mly"
( _1 )
-# 5956 "parsing/parser.ml"
+# 5978 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1723 "parsing/parser.mly"
+# 1743 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 6013 "parsing/parser.ml"
+# 6035 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 823 "parsing/parser.mly"
+# 845 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 6023 "parsing/parser.ml"
+# 6045 "parsing/parser.ml"
in
-# 1724 "parsing/parser.mly"
+# 1744 "parsing/parser.mly"
( _1 )
-# 6029 "parsing/parser.ml"
+# 6051 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 6086 "parsing/parser.ml"
+# 6108 "parsing/parser.ml"
in
-# 1751 "parsing/parser.mly"
+# 1771 "parsing/parser.mly"
( _1 )
-# 6091 "parsing/parser.ml"
+# 6113 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 764 "parsing/parser.mly"
+# 786 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 6100 "parsing/parser.ml"
+# 6122 "parsing/parser.ml"
in
-# 1738 "parsing/parser.mly"
+# 1758 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 6106 "parsing/parser.ml"
+# 6128 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 6114 "parsing/parser.ml"
+# 6136 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1726 "parsing/parser.mly"
+# 1746 "parsing/parser.mly"
( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
-# 6123 "parsing/parser.ml"
+# 6145 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) =
-# 1829 "parsing/parser.mly"
+# 1849 "parsing/parser.mly"
( _1 )
-# 6148 "parsing/parser.ml"
+# 6170 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3154 "parsing/parser.mly"
+# 3177 "parsing/parser.mly"
( Optional label )
-# 6196 "parsing/parser.ml"
+# 6218 "parsing/parser.ml"
in
-# 1835 "parsing/parser.mly"
+# 1855 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6201 "parsing/parser.ml"
+# 6223 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6211 "parsing/parser.ml"
+# 6233 "parsing/parser.ml"
in
-# 1836 "parsing/parser.mly"
+# 1856 "parsing/parser.mly"
( _1 )
-# 6217 "parsing/parser.ml"
+# 6239 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let domain : (Parsetree.core_type) = Obj.magic domain in
let _2 : unit = Obj.magic _2 in
let label : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 6266 "parsing/parser.ml"
+# 6288 "parsing/parser.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3156 "parsing/parser.mly"
+# 3179 "parsing/parser.mly"
( Labelled label )
-# 6276 "parsing/parser.ml"
+# 6298 "parsing/parser.ml"
in
-# 1835 "parsing/parser.mly"
+# 1855 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6281 "parsing/parser.ml"
+# 6303 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6291 "parsing/parser.ml"
+# 6313 "parsing/parser.ml"
in
-# 1836 "parsing/parser.mly"
+# 1856 "parsing/parser.mly"
( _1 )
-# 6297 "parsing/parser.ml"
+# 6319 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3158 "parsing/parser.mly"
+# 3181 "parsing/parser.mly"
( Nolabel )
-# 6338 "parsing/parser.ml"
+# 6360 "parsing/parser.ml"
in
-# 1835 "parsing/parser.mly"
+# 1855 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6343 "parsing/parser.ml"
+# 6365 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6353 "parsing/parser.ml"
+# 6375 "parsing/parser.ml"
in
-# 1836 "parsing/parser.mly"
+# 1856 "parsing/parser.mly"
( _1 )
-# 6359 "parsing/parser.ml"
+# 6381 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let csig : (Parsetree.class_type) = Obj.magic csig in
let _8 : unit = Obj.magic _8 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 6444 "parsing/parser.ml"
+# 6466 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 6462 "parsing/parser.ml"
+# 6484 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 6474 "parsing/parser.ml"
+# 6496 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 6482 "parsing/parser.ml"
+# 6504 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1974 "parsing/parser.mly"
+# 1994 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
)
-# 6497 "parsing/parser.ml"
+# 6519 "parsing/parser.ml"
in
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 6503 "parsing/parser.ml"
+# 6525 "parsing/parser.ml"
in
-# 1962 "parsing/parser.mly"
+# 1982 "parsing/parser.mly"
( _1 )
-# 6509 "parsing/parser.ml"
+# 6531 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 6530 "parsing/parser.ml"
+# 6552 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3435 "parsing/parser.mly"
+# 3462 "parsing/parser.mly"
( Lident _1 )
-# 6538 "parsing/parser.ml"
+# 6560 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 6571 "parsing/parser.ml"
+# 6593 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3436 "parsing/parser.mly"
+# 3463 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 6581 "parsing/parser.ml"
+# 6603 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 606 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string * char option)
-# 6602 "parsing/parser.ml"
+# 6624 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3326 "parsing/parser.mly"
+# 3349 "parsing/parser.mly"
( let (n, m) = _1 in Pconst_integer (n, m) )
-# 6610 "parsing/parser.ml"
+# 6632 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 565 "parsing/parser.mly"
+# 587 "parsing/parser.mly"
(char)
-# 6631 "parsing/parser.ml"
+# 6653 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3327 "parsing/parser.mly"
+# 3350 "parsing/parser.mly"
( Pconst_char _1 )
-# 6639 "parsing/parser.ml"
+# 6661 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 658 "parsing/parser.mly"
+# 680 "parsing/parser.mly"
(string * string option)
-# 6660 "parsing/parser.ml"
+# 6682 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3328 "parsing/parser.mly"
+# 3351 "parsing/parser.mly"
( let (s, d) = _1 in Pconst_string (s, d) )
-# 6668 "parsing/parser.ml"
+# 6690 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 585 "parsing/parser.mly"
+# 607 "parsing/parser.mly"
(string * char option)
-# 6689 "parsing/parser.ml"
+# 6711 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3329 "parsing/parser.mly"
+# 3352 "parsing/parser.mly"
( let (f, m) = _1 in Pconst_float (f, m) )
-# 6697 "parsing/parser.ml"
+# 6719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 6718 "parsing/parser.ml"
+# 6740 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3389 "parsing/parser.mly"
+# 3416 "parsing/parser.mly"
( _1 )
-# 6726 "parsing/parser.ml"
+# 6748 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3390 "parsing/parser.mly"
+# 3417 "parsing/parser.mly"
( "[]" )
-# 6758 "parsing/parser.ml"
+# 6780 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3391 "parsing/parser.mly"
+# 3418 "parsing/parser.mly"
( "()" )
-# 6790 "parsing/parser.ml"
+# 6812 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) =
-# 3392 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( "::" )
-# 6829 "parsing/parser.ml"
+# 6851 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3393 "parsing/parser.mly"
+# 3420 "parsing/parser.mly"
( "false" )
-# 6854 "parsing/parser.ml"
+# 6876 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3394 "parsing/parser.mly"
+# 3421 "parsing/parser.mly"
( "true" )
-# 6879 "parsing/parser.ml"
+# 6901 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3402 "parsing/parser.mly"
+# 3429 "parsing/parser.mly"
( _1 )
-# 6904 "parsing/parser.ml"
+# 6926 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Longident.t) =
-# 3403 "parsing/parser.mly"
+# 3430 "parsing/parser.mly"
( Ldot(_1,"::") )
-# 6957 "parsing/parser.ml"
+# 6979 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 3404 "parsing/parser.mly"
+# 3431 "parsing/parser.mly"
( Lident "[]" )
-# 6989 "parsing/parser.ml"
+# 7011 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 3405 "parsing/parser.mly"
+# 3432 "parsing/parser.mly"
( Lident "()" )
-# 7021 "parsing/parser.ml"
+# 7043 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3406 "parsing/parser.mly"
+# 3433 "parsing/parser.mly"
( Lident "::" )
-# 7060 "parsing/parser.ml"
+# 7082 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3407 "parsing/parser.mly"
+# 3434 "parsing/parser.mly"
( Lident "false" )
-# 7085 "parsing/parser.ml"
+# 7107 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3408 "parsing/parser.mly"
+# 3435 "parsing/parser.mly"
( Lident "true" )
-# 7110 "parsing/parser.ml"
+# 7132 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type * Parsetree.core_type) =
-# 1918 "parsing/parser.mly"
+# 1938 "parsing/parser.mly"
( _1, _3 )
-# 7149 "parsing/parser.ml"
+# 7171 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 7176 "parsing/parser.ml"
+# 7198 "parsing/parser.ml"
in
# 253 "menhir/standard.mly"
( List.rev xs )
-# 7181 "parsing/parser.ml"
+# 7203 "parsing/parser.ml"
in
-# 908 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( xs )
-# 7187 "parsing/parser.ml"
+# 7209 "parsing/parser.ml"
in
-# 2961 "parsing/parser.mly"
+# 2984 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7193 "parsing/parser.ml"
+# 7215 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 7234 "parsing/parser.ml"
+# 7256 "parsing/parser.ml"
in
# 253 "menhir/standard.mly"
( List.rev xs )
-# 7239 "parsing/parser.ml"
+# 7261 "parsing/parser.ml"
in
-# 908 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( xs )
-# 7245 "parsing/parser.ml"
+# 7267 "parsing/parser.ml"
in
-# 2961 "parsing/parser.mly"
+# 2984 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7251 "parsing/parser.ml"
+# 7273 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.constructor_arguments) =
-# 2963 "parsing/parser.mly"
+# 2986 "parsing/parser.mly"
( Pcstr_record _2 )
-# 7290 "parsing/parser.ml"
+# 7312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constructor_declaration list) =
-# 2882 "parsing/parser.mly"
+# 2905 "parsing/parser.mly"
( [] )
-# 7315 "parsing/parser.ml"
+# 7337 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.constructor_declaration list) = let cs =
-# 993 "parsing/parser.mly"
+# 1015 "parsing/parser.mly"
( List.rev xs )
-# 7340 "parsing/parser.ml"
+# 7362 "parsing/parser.ml"
in
-# 2884 "parsing/parser.mly"
+# 2907 "parsing/parser.mly"
( cs )
-# 7345 "parsing/parser.ml"
+# 7367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 7370 "parsing/parser.ml"
+# 7392 "parsing/parser.ml"
in
-# 3106 "parsing/parser.mly"
+# 3129 "parsing/parser.mly"
( _1 )
-# 7375 "parsing/parser.ml"
+# 7397 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 3108 "parsing/parser.mly"
+# 3131 "parsing/parser.mly"
( Typ.attr _1 _2 )
-# 7407 "parsing/parser.ml"
+# 7429 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3489 "parsing/parser.mly"
+# 3516 "parsing/parser.mly"
( Upto )
-# 7432 "parsing/parser.ml"
+# 7454 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3490 "parsing/parser.mly"
+# 3517 "parsing/parser.mly"
( Downto )
-# 7457 "parsing/parser.ml"
+# 7479 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2065 "parsing/parser.mly"
+# 2085 "parsing/parser.mly"
( _1 )
-# 7482 "parsing/parser.ml"
+# 7504 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _7 : (Parsetree.expression) = Obj.magic _7 in
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.module_expr) = Obj.magic _5 in
- let _1_inlined3 : (
-# 666 "parsing/parser.mly"
- (string)
-# 7548 "parsing/parser.ml"
- ) = Obj.magic _1_inlined3 in
+ let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7566 "parsing/parser.ml"
+# 7584 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 7576 "parsing/parser.ml"
+# 7594 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 7582 "parsing/parser.ml"
+# 7600 "parsing/parser.ml"
in
-# 2110 "parsing/parser.mly"
+# 2133 "parsing/parser.mly"
( Pexp_letmodule(_4, _5, _7), _3 )
-# 7588 "parsing/parser.ml"
+# 7606 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7599 "parsing/parser.ml"
+# 7617 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 7685 "parsing/parser.ml"
+# 7703 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7696 "parsing/parser.ml"
+# 7714 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2946 "parsing/parser.mly"
+# 2969 "parsing/parser.mly"
( let args, res = _2 in
Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
-# 7706 "parsing/parser.ml"
+# 7724 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 7716 "parsing/parser.ml"
+# 7734 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 7722 "parsing/parser.ml"
+# 7740 "parsing/parser.ml"
in
-# 2112 "parsing/parser.mly"
+# 2135 "parsing/parser.mly"
( Pexp_letexception(_4, _6), _3 )
-# 7728 "parsing/parser.ml"
+# 7746 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7739 "parsing/parser.ml"
+# 7757 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 7811 "parsing/parser.ml"
+# 7829 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 7817 "parsing/parser.ml"
+# 7835 "parsing/parser.ml"
in
let _3 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 7823 "parsing/parser.ml"
+# 7841 "parsing/parser.ml"
in
-# 2114 "parsing/parser.mly"
+# 2137 "parsing/parser.mly"
( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
Pexp_open(od, _7), _4 )
-# 7830 "parsing/parser.ml"
+# 7848 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7841 "parsing/parser.ml"
+# 7859 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 7920 "parsing/parser.ml"
+# 7938 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 7926 "parsing/parser.ml"
+# 7944 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 7934 "parsing/parser.ml"
+# 7952 "parsing/parser.ml"
in
-# 2114 "parsing/parser.mly"
+# 2137 "parsing/parser.mly"
( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
Pexp_open(od, _7), _4 )
-# 7942 "parsing/parser.ml"
+# 7960 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7953 "parsing/parser.ml"
+# 7971 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 8002 "parsing/parser.ml"
+# 8020 "parsing/parser.ml"
in
-# 965 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( xs )
-# 8007 "parsing/parser.ml"
+# 8025 "parsing/parser.ml"
in
-# 2446 "parsing/parser.mly"
+# 2469 "parsing/parser.mly"
( xs )
-# 8013 "parsing/parser.ml"
+# 8031 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8023 "parsing/parser.ml"
+# 8041 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8029 "parsing/parser.ml"
+# 8047 "parsing/parser.ml"
in
-# 2118 "parsing/parser.mly"
+# 2141 "parsing/parser.mly"
( Pexp_function _3, _2 )
-# 8035 "parsing/parser.ml"
+# 8053 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8046 "parsing/parser.ml"
+# 8064 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8104 "parsing/parser.ml"
+# 8122 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8110 "parsing/parser.ml"
+# 8128 "parsing/parser.ml"
in
-# 2120 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let (l,o,p) = _3 in
Pexp_fun(l, o, p, _4), _2 )
-# 8117 "parsing/parser.ml"
+# 8135 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8128 "parsing/parser.ml"
+# 8146 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _1 =
let _5 =
-# 2341 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( xs )
-# 8203 "parsing/parser.ml"
+# 8221 "parsing/parser.ml"
in
let _2 =
let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8212 "parsing/parser.ml"
+# 8230 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8218 "parsing/parser.ml"
+# 8236 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2123 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 )
-# 8227 "parsing/parser.ml"
+# 8245 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8238 "parsing/parser.ml"
+# 8256 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 8301 "parsing/parser.ml"
+# 8319 "parsing/parser.ml"
in
-# 965 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( xs )
-# 8306 "parsing/parser.ml"
+# 8324 "parsing/parser.ml"
in
-# 2446 "parsing/parser.mly"
+# 2469 "parsing/parser.mly"
( xs )
-# 8312 "parsing/parser.ml"
+# 8330 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8322 "parsing/parser.ml"
+# 8340 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8328 "parsing/parser.ml"
+# 8346 "parsing/parser.ml"
in
-# 2125 "parsing/parser.mly"
+# 2148 "parsing/parser.mly"
( Pexp_match(_3, _5), _2 )
-# 8334 "parsing/parser.ml"
+# 8352 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8345 "parsing/parser.ml"
+# 8363 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 8408 "parsing/parser.ml"
+# 8426 "parsing/parser.ml"
in
-# 965 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( xs )
-# 8413 "parsing/parser.ml"
+# 8431 "parsing/parser.ml"
in
-# 2446 "parsing/parser.mly"
+# 2469 "parsing/parser.mly"
( xs )
-# 8419 "parsing/parser.ml"
+# 8437 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8429 "parsing/parser.ml"
+# 8447 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8435 "parsing/parser.ml"
+# 8453 "parsing/parser.ml"
in
-# 2127 "parsing/parser.mly"
+# 2150 "parsing/parser.mly"
( Pexp_try(_3, _5), _2 )
-# 8441 "parsing/parser.ml"
+# 8459 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8452 "parsing/parser.ml"
+# 8470 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8517 "parsing/parser.ml"
+# 8535 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8523 "parsing/parser.ml"
+# 8541 "parsing/parser.ml"
in
-# 2129 "parsing/parser.mly"
+# 2152 "parsing/parser.mly"
( syntax_error() )
-# 8529 "parsing/parser.ml"
+# 8547 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8540 "parsing/parser.ml"
+# 8558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8619 "parsing/parser.ml"
+# 8637 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8625 "parsing/parser.ml"
+# 8643 "parsing/parser.ml"
in
-# 2131 "parsing/parser.mly"
+# 2154 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 8631 "parsing/parser.ml"
+# 8649 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8642 "parsing/parser.ml"
+# 8660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8707 "parsing/parser.ml"
+# 8725 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8713 "parsing/parser.ml"
+# 8731 "parsing/parser.ml"
in
-# 2133 "parsing/parser.mly"
+# 2156 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, None), _2 )
-# 8719 "parsing/parser.ml"
+# 8737 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8730 "parsing/parser.ml"
+# 8748 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8802 "parsing/parser.ml"
+# 8820 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8808 "parsing/parser.ml"
+# 8826 "parsing/parser.ml"
in
-# 2135 "parsing/parser.mly"
+# 2158 "parsing/parser.mly"
( Pexp_while(_3, _5), _2 )
-# 8814 "parsing/parser.ml"
+# 8832 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8825 "parsing/parser.ml"
+# 8843 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8925 "parsing/parser.ml"
+# 8943 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 8931 "parsing/parser.ml"
+# 8949 "parsing/parser.ml"
in
-# 2138 "parsing/parser.mly"
+# 2161 "parsing/parser.mly"
( Pexp_for(_3, _5, _7, _6, _9), _2 )
-# 8937 "parsing/parser.ml"
+# 8955 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__10_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8948 "parsing/parser.ml"
+# 8966 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 8999 "parsing/parser.ml"
+# 9017 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 9005 "parsing/parser.ml"
+# 9023 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2163 "parsing/parser.mly"
( Pexp_assert _3, _2 )
-# 9011 "parsing/parser.ml"
+# 9029 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9022 "parsing/parser.ml"
+# 9040 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 9073 "parsing/parser.ml"
+# 9091 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 9079 "parsing/parser.ml"
+# 9097 "parsing/parser.ml"
in
-# 2142 "parsing/parser.mly"
+# 2165 "parsing/parser.mly"
( Pexp_lazy _3, _2 )
-# 9085 "parsing/parser.ml"
+# 9103 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9096 "parsing/parser.ml"
+# 9114 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 9161 "parsing/parser.ml"
+# 9179 "parsing/parser.ml"
in
-# 1751 "parsing/parser.mly"
+# 1771 "parsing/parser.mly"
( _1 )
-# 9166 "parsing/parser.ml"
+# 9184 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 764 "parsing/parser.mly"
+# 786 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 9175 "parsing/parser.ml"
+# 9193 "parsing/parser.ml"
in
-# 1738 "parsing/parser.mly"
+# 1758 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 9181 "parsing/parser.ml"
+# 9199 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 9191 "parsing/parser.ml"
+# 9209 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 9197 "parsing/parser.ml"
+# 9215 "parsing/parser.ml"
in
-# 2144 "parsing/parser.mly"
+# 2167 "parsing/parser.mly"
( Pexp_object _3, _2 )
-# 9203 "parsing/parser.ml"
+# 9221 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9214 "parsing/parser.ml"
+# 9232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 9279 "parsing/parser.ml"
+# 9297 "parsing/parser.ml"
in
-# 1751 "parsing/parser.mly"
+# 1771 "parsing/parser.mly"
( _1 )
-# 9284 "parsing/parser.ml"
+# 9302 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 764 "parsing/parser.mly"
+# 786 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 9293 "parsing/parser.ml"
+# 9311 "parsing/parser.ml"
in
-# 1738 "parsing/parser.mly"
+# 1758 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 9299 "parsing/parser.ml"
+# 9317 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 9309 "parsing/parser.ml"
+# 9327 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 9315 "parsing/parser.ml"
+# 9333 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2146 "parsing/parser.mly"
+# 2169 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 9323 "parsing/parser.ml"
+# 9341 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9334 "parsing/parser.ml"
+# 9352 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 9369 "parsing/parser.ml"
+# 9387 "parsing/parser.ml"
in
-# 872 "parsing/parser.mly"
+# 894 "parsing/parser.mly"
( xs )
-# 9374 "parsing/parser.ml"
+# 9392 "parsing/parser.ml"
in
-# 2150 "parsing/parser.mly"
+# 2173 "parsing/parser.mly"
( Pexp_apply(_1, _2) )
-# 9380 "parsing/parser.ml"
+# 9398 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9390 "parsing/parser.ml"
+# 9408 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9396 "parsing/parser.ml"
+# 9414 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 9425 "parsing/parser.ml"
+# 9443 "parsing/parser.ml"
in
-# 932 "parsing/parser.mly"
+# 954 "parsing/parser.mly"
( xs )
-# 9430 "parsing/parser.ml"
+# 9448 "parsing/parser.ml"
in
-# 2473 "parsing/parser.mly"
+# 2496 "parsing/parser.mly"
( es )
-# 9436 "parsing/parser.ml"
+# 9454 "parsing/parser.ml"
in
-# 2152 "parsing/parser.mly"
+# 2175 "parsing/parser.mly"
( Pexp_tuple(_1) )
-# 9442 "parsing/parser.ml"
+# 9460 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9452 "parsing/parser.ml"
+# 9470 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9458 "parsing/parser.ml"
+# 9476 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 9496 "parsing/parser.ml"
+# 9514 "parsing/parser.ml"
in
-# 2154 "parsing/parser.mly"
+# 2177 "parsing/parser.mly"
( Pexp_construct(_1, Some _2) )
-# 9502 "parsing/parser.ml"
+# 9520 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9512 "parsing/parser.ml"
+# 9530 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9518 "parsing/parser.ml"
+# 9536 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2156 "parsing/parser.mly"
+# 2179 "parsing/parser.mly"
( Pexp_variant(_1, Some _2) )
-# 9551 "parsing/parser.ml"
+# 9569 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9560 "parsing/parser.ml"
+# 9578 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9566 "parsing/parser.ml"
+# 9584 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 596 "parsing/parser.mly"
+# 618 "parsing/parser.mly"
(string)
-# 9600 "parsing/parser.ml"
+# 9618 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3367 "parsing/parser.mly"
+# 3390 "parsing/parser.mly"
( op )
-# 9612 "parsing/parser.ml"
+# 9630 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9621 "parsing/parser.ml"
+# 9639 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9627 "parsing/parser.ml"
+# 9645 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9637 "parsing/parser.ml"
+# 9655 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9643 "parsing/parser.ml"
+# 9661 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 597 "parsing/parser.mly"
+# 619 "parsing/parser.mly"
(string)
-# 9677 "parsing/parser.ml"
+# 9695 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3368 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
( op )
-# 9689 "parsing/parser.ml"
+# 9707 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9698 "parsing/parser.ml"
+# 9716 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9704 "parsing/parser.ml"
+# 9722 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9714 "parsing/parser.ml"
+# 9732 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9720 "parsing/parser.ml"
+# 9738 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 598 "parsing/parser.mly"
+# 620 "parsing/parser.mly"
(string)
-# 9754 "parsing/parser.ml"
+# 9772 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3369 "parsing/parser.mly"
+# 3392 "parsing/parser.mly"
( op )
-# 9766 "parsing/parser.ml"
+# 9784 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9775 "parsing/parser.ml"
+# 9793 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9781 "parsing/parser.ml"
+# 9799 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9791 "parsing/parser.ml"
+# 9809 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9797 "parsing/parser.ml"
+# 9815 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 599 "parsing/parser.mly"
+# 621 "parsing/parser.mly"
(string)
-# 9831 "parsing/parser.ml"
+# 9849 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3370 "parsing/parser.mly"
+# 3393 "parsing/parser.mly"
( op )
-# 9843 "parsing/parser.ml"
+# 9861 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9852 "parsing/parser.ml"
+# 9870 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9858 "parsing/parser.ml"
+# 9876 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9868 "parsing/parser.ml"
+# 9886 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9874 "parsing/parser.ml"
+# 9892 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 600 "parsing/parser.mly"
+# 622 "parsing/parser.mly"
(string)
-# 9908 "parsing/parser.ml"
+# 9926 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3371 "parsing/parser.mly"
+# 3394 "parsing/parser.mly"
( op )
-# 9920 "parsing/parser.ml"
+# 9938 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9929 "parsing/parser.ml"
+# 9947 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9935 "parsing/parser.ml"
+# 9953 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9945 "parsing/parser.ml"
+# 9963 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 9951 "parsing/parser.ml"
+# 9969 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3372 "parsing/parser.mly"
+# 3395 "parsing/parser.mly"
("+")
-# 9993 "parsing/parser.ml"
+# 10011 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10001 "parsing/parser.ml"
+# 10019 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10007 "parsing/parser.ml"
+# 10025 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10017 "parsing/parser.ml"
+# 10035 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10023 "parsing/parser.ml"
+# 10041 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3373 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
("+.")
-# 10065 "parsing/parser.ml"
+# 10083 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10073 "parsing/parser.ml"
+# 10091 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10079 "parsing/parser.ml"
+# 10097 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10089 "parsing/parser.ml"
+# 10107 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10095 "parsing/parser.ml"
+# 10113 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3374 "parsing/parser.mly"
+# 3397 "parsing/parser.mly"
("+=")
-# 10137 "parsing/parser.ml"
+# 10155 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10145 "parsing/parser.ml"
+# 10163 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10151 "parsing/parser.ml"
+# 10169 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10161 "parsing/parser.ml"
+# 10179 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10167 "parsing/parser.ml"
+# 10185 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3375 "parsing/parser.mly"
+# 3398 "parsing/parser.mly"
("-")
-# 10209 "parsing/parser.ml"
+# 10227 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10217 "parsing/parser.ml"
+# 10235 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10223 "parsing/parser.ml"
+# 10241 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10233 "parsing/parser.ml"
+# 10251 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10239 "parsing/parser.ml"
+# 10257 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3376 "parsing/parser.mly"
+# 3399 "parsing/parser.mly"
("-.")
-# 10281 "parsing/parser.ml"
+# 10299 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10289 "parsing/parser.ml"
+# 10307 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10295 "parsing/parser.ml"
+# 10313 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10305 "parsing/parser.ml"
+# 10323 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10311 "parsing/parser.ml"
+# 10329 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3377 "parsing/parser.mly"
+# 3400 "parsing/parser.mly"
("*")
-# 10353 "parsing/parser.ml"
+# 10371 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10361 "parsing/parser.ml"
+# 10379 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10367 "parsing/parser.ml"
+# 10385 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10377 "parsing/parser.ml"
+# 10395 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10383 "parsing/parser.ml"
+# 10401 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3378 "parsing/parser.mly"
+# 3401 "parsing/parser.mly"
("%")
-# 10425 "parsing/parser.ml"
+# 10443 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10433 "parsing/parser.ml"
+# 10451 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10439 "parsing/parser.ml"
+# 10457 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10449 "parsing/parser.ml"
+# 10467 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10455 "parsing/parser.ml"
+# 10473 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3379 "parsing/parser.mly"
+# 3402 "parsing/parser.mly"
("=")
-# 10497 "parsing/parser.ml"
+# 10515 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10505 "parsing/parser.ml"
+# 10523 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10511 "parsing/parser.ml"
+# 10529 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10521 "parsing/parser.ml"
+# 10539 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10527 "parsing/parser.ml"
+# 10545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3380 "parsing/parser.mly"
+# 3403 "parsing/parser.mly"
("<")
-# 10569 "parsing/parser.ml"
+# 10587 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10577 "parsing/parser.ml"
+# 10595 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10583 "parsing/parser.ml"
+# 10601 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10593 "parsing/parser.ml"
+# 10611 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10599 "parsing/parser.ml"
+# 10617 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3381 "parsing/parser.mly"
+# 3404 "parsing/parser.mly"
(">")
-# 10641 "parsing/parser.ml"
+# 10659 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10649 "parsing/parser.ml"
+# 10667 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10655 "parsing/parser.ml"
+# 10673 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10665 "parsing/parser.ml"
+# 10683 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10671 "parsing/parser.ml"
+# 10689 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3382 "parsing/parser.mly"
+# 3405 "parsing/parser.mly"
("or")
-# 10713 "parsing/parser.ml"
+# 10731 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10721 "parsing/parser.ml"
+# 10739 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10727 "parsing/parser.ml"
+# 10745 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10737 "parsing/parser.ml"
+# 10755 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10743 "parsing/parser.ml"
+# 10761 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3383 "parsing/parser.mly"
+# 3406 "parsing/parser.mly"
("||")
-# 10785 "parsing/parser.ml"
+# 10803 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10793 "parsing/parser.ml"
+# 10811 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10799 "parsing/parser.ml"
+# 10817 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10809 "parsing/parser.ml"
+# 10827 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10815 "parsing/parser.ml"
+# 10833 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3384 "parsing/parser.mly"
+# 3407 "parsing/parser.mly"
("&")
-# 10857 "parsing/parser.ml"
+# 10875 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10865 "parsing/parser.ml"
+# 10883 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10871 "parsing/parser.ml"
+# 10889 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10881 "parsing/parser.ml"
+# 10899 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10887 "parsing/parser.ml"
+# 10905 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3385 "parsing/parser.mly"
+# 3408 "parsing/parser.mly"
("&&")
-# 10929 "parsing/parser.ml"
+# 10947 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10937 "parsing/parser.ml"
+# 10955 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10943 "parsing/parser.ml"
+# 10961 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10953 "parsing/parser.ml"
+# 10971 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 10959 "parsing/parser.ml"
+# 10977 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3386 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
(":=")
-# 11001 "parsing/parser.ml"
+# 11019 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 11009 "parsing/parser.ml"
+# 11027 "parsing/parser.ml"
in
-# 2158 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 11015 "parsing/parser.ml"
+# 11033 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11025 "parsing/parser.ml"
+# 11043 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 11031 "parsing/parser.ml"
+# 11049 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2160 "parsing/parser.mly"
+# 2183 "parsing/parser.mly"
( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 11066 "parsing/parser.ml"
+# 11084 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11076 "parsing/parser.ml"
+# 11094 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 11082 "parsing/parser.ml"
+# 11100 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2162 "parsing/parser.mly"
+# 2185 "parsing/parser.mly"
( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 11117 "parsing/parser.ml"
+# 11135 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11127 "parsing/parser.ml"
+# 11145 "parsing/parser.ml"
in
-# 2070 "parsing/parser.mly"
+# 2090 "parsing/parser.mly"
( _1 )
-# 11133 "parsing/parser.ml"
+# 11151 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2072 "parsing/parser.mly"
+# 2092 "parsing/parser.mly"
( expr_of_let_bindings ~loc:_sloc _1 _3 )
-# 11175 "parsing/parser.ml"
+# 11193 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : unit = Obj.magic _3 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _1 : (
-# 602 "parsing/parser.mly"
+# 624 "parsing/parser.mly"
(string)
-# 11217 "parsing/parser.ml"
+# 11235 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11229 "parsing/parser.ml"
+# 11247 "parsing/parser.ml"
in
let _startpos_pbop_op_ = _startpos__1_ in
let _symbolstartpos = _startpos_pbop_op_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2074 "parsing/parser.mly"
+# 2094 "parsing/parser.mly"
( let (pbop_pat, pbop_exp, rev_ands) = bindings in
let ands = List.rev rev_ands in
let pbop_loc = make_loc _sloc in
let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
mkexp ~loc:_sloc (Pexp_letop{ let_; ands; body}) )
-# 11243 "parsing/parser.ml"
+# 11261 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2080 "parsing/parser.mly"
+# 2100 "parsing/parser.mly"
( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
-# 11286 "parsing/parser.ml"
+# 11304 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 11321 "parsing/parser.ml"
+# 11339 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 11330 "parsing/parser.ml"
+# 11348 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11338 "parsing/parser.ml"
+# 11356 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2082 "parsing/parser.mly"
+# 2102 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 11347 "parsing/parser.ml"
+# 11365 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11405 "parsing/parser.ml"
+# 11423 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2084 "parsing/parser.mly"
+# 2104 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 11414 "parsing/parser.ml"
+# 11432 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2086 "parsing/parser.mly"
+# 2106 "parsing/parser.mly"
( array_set ~loc:_sloc _1 _4 _7 )
-# 11484 "parsing/parser.ml"
+# 11502 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2088 "parsing/parser.mly"
+# 2108 "parsing/parser.mly"
( string_set ~loc:_sloc _1 _4 _7 )
-# 11554 "parsing/parser.ml"
+# 11572 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2090 "parsing/parser.mly"
+# 2110 "parsing/parser.mly"
( bigarray_set ~loc:_sloc _1 _4 _7 )
-# 11624 "parsing/parser.ml"
+# 11642 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
let _7 : (Parsetree.expression) = Obj.magic _7 in
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 11686 "parsing/parser.ml"
+# 11704 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 11713 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2092 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (Lident ("." ^ _2 ^ "[]<-")) _1 _4 _7 )
-# 11698 "parsing/parser.ml"
+# 2112 "parsing/parser.mly"
+ ( dotop_set ~loc:_sloc lident bracket _2 _1 _4 _7 )
+# 11721 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
let _7 : (Parsetree.expression) = Obj.magic _7 in
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 11760 "parsing/parser.ml"
+# 11783 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 11792 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2094 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (Lident ("." ^ _2 ^ "()<-")) _1 _4 _7 )
-# 11772 "parsing/parser.ml"
+# 2114 "parsing/parser.mly"
+ ( dotop_set ~loc:_sloc lident paren _2 _1 _4 _7 )
+# 11800 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
let _7 : (Parsetree.expression) = Obj.magic _7 in
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 11834 "parsing/parser.ml"
+# 11862 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 11871 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2096 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (Lident ("." ^ _2 ^ "{}<-")) _1 _4 _7 )
-# 11846 "parsing/parser.ml"
+# 2116 "parsing/parser.mly"
+ ( dotop_set ~loc:_sloc lident brace _2 _1 _4 _7 )
+# 11879 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
let _9 : (Parsetree.expression) = Obj.magic _9 in
let _8 : unit = Obj.magic _8 in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 11920 "parsing/parser.ml"
+# 11953 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__9_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__9_ in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 11964 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2098 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (Ldot(_3,"." ^ _4 ^ "[]<-")) _1 _6 _9 )
-# 11934 "parsing/parser.ml"
+# 2119 "parsing/parser.mly"
+ ( dotop_set ~loc:_sloc (ldot _3) bracket _4 _1 _6 _9 )
+# 11972 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
let _9 : (Parsetree.expression) = Obj.magic _9 in
let _8 : unit = Obj.magic _8 in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 12008 "parsing/parser.ml"
+# 12046 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__9_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__9_ in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 12057 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2100 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "()<-")) _1 _6 _9 )
-# 12022 "parsing/parser.ml"
+# 2122 "parsing/parser.mly"
+ ( dotop_set ~loc:_sloc (ldot _3) paren _4 _1 _6 _9 )
+# 12065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
let _9 : (Parsetree.expression) = Obj.magic _9 in
let _8 : unit = Obj.magic _8 in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 12096 "parsing/parser.ml"
+# 12139 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__9_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__9_ in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 12150 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2102 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "{}<-")) _1 _6 _9 )
-# 12110 "parsing/parser.ml"
+# 2125 "parsing/parser.mly"
+ ( dotop_set ~loc:_sloc (ldot _3) brace _4 _1 _6 _9 )
+# 12158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2104 "parsing/parser.mly"
+# 2127 "parsing/parser.mly"
( Exp.attr _1 _2 )
-# 12142 "parsing/parser.ml"
+# 12190 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2106 "parsing/parser.mly"
+# 2129 "parsing/parser.mly"
( not_expecting _loc__1_ "wildcard \"_\"" )
-# 12168 "parsing/parser.ml"
+# 12216 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string Asttypes.loc option) =
-# 3645 "parsing/parser.mly"
+# 3672 "parsing/parser.mly"
( None )
-# 12186 "parsing/parser.ml"
+# 12234 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string Asttypes.loc option) =
-# 3646 "parsing/parser.mly"
+# 3673 "parsing/parser.mly"
( Some _2 )
-# 12218 "parsing/parser.ml"
+# 12266 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3656 "parsing/parser.mly"
+# 3683 "parsing/parser.mly"
( (_2, _3) )
-# 12264 "parsing/parser.ml"
+# 12312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined3 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 12319 "parsing/parser.ml"
+# 12367 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12331 "parsing/parser.ml"
+# 12379 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12342 "parsing/parser.ml"
+# 12390 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3030 "parsing/parser.mly"
+# 3053 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12352 "parsing/parser.ml"
+# 12400 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 12400 "parsing/parser.ml"
+# 12448 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12412 "parsing/parser.ml"
+# 12460 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12422 "parsing/parser.ml"
+# 12470 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3465 "parsing/parser.mly"
+# 3492 "parsing/parser.mly"
( () )
-# 12429 "parsing/parser.ml"
+# 12477 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3030 "parsing/parser.mly"
+# 3053 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12438 "parsing/parser.ml"
+# 12486 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3633 "parsing/parser.mly"
+# 3660 "parsing/parser.mly"
( mark_symbol_docs _sloc;
Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 12488 "parsing/parser.ml"
+# 12536 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * Asttypes.variance) list) = let params =
-# 1858 "parsing/parser.mly"
+# 1878 "parsing/parser.mly"
( [] )
-# 12506 "parsing/parser.ml"
+# 12554 "parsing/parser.ml"
in
-# 1683 "parsing/parser.mly"
+# 1703 "parsing/parser.mly"
( params )
-# 12511 "parsing/parser.ml"
+# 12559 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 12552 "parsing/parser.ml"
+# 12600 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 12557 "parsing/parser.ml"
+# 12605 "parsing/parser.ml"
in
-# 1860 "parsing/parser.mly"
+# 1880 "parsing/parser.mly"
( params )
-# 12563 "parsing/parser.ml"
+# 12611 "parsing/parser.ml"
in
-# 1683 "parsing/parser.mly"
+# 1703 "parsing/parser.mly"
( params )
-# 12569 "parsing/parser.ml"
+# 12617 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2432 "parsing/parser.mly"
+# 2455 "parsing/parser.mly"
( _1 )
-# 12594 "parsing/parser.ml"
+# 12642 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2434 "parsing/parser.mly"
+# 2457 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _3 _1 )
-# 12636 "parsing/parser.ml"
+# 12684 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2458 "parsing/parser.mly"
+# 2481 "parsing/parser.mly"
( _2 )
-# 12668 "parsing/parser.ml"
+# 12716 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2460 "parsing/parser.mly"
+# 2483 "parsing/parser.mly"
( Pexp_constraint (_4, _2) )
-# 12715 "parsing/parser.ml"
+# 12763 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 12724 "parsing/parser.ml"
+# 12772 "parsing/parser.ml"
in
-# 2461 "parsing/parser.mly"
+# 2484 "parsing/parser.mly"
( _1 )
-# 12730 "parsing/parser.ml"
+# 12778 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2464 "parsing/parser.mly"
+# 2487 "parsing/parser.mly"
(
let (l,o,p) = _1 in
ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2))
)
-# 12768 "parsing/parser.ml"
+# 12816 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _3 =
-# 2341 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( xs )
-# 12821 "parsing/parser.ml"
+# 12869 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2469 "parsing/parser.mly"
+# 2492 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 12829 "parsing/parser.ml"
+# 12877 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3142 "parsing/parser.mly"
+# 3165 "parsing/parser.mly"
( ty )
-# 12854 "parsing/parser.ml"
+# 12902 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 768 "parsing/parser.mly"
+# 790 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 12902 "parsing/parser.ml"
+# 12950 "parsing/parser.ml"
in
let label =
-# 3154 "parsing/parser.mly"
+# 3177 "parsing/parser.mly"
( Optional label )
-# 12907 "parsing/parser.ml"
+# 12955 "parsing/parser.ml"
in
-# 3148 "parsing/parser.mly"
+# 3171 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 12912 "parsing/parser.ml"
+# 12960 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 12922 "parsing/parser.ml"
+# 12970 "parsing/parser.ml"
in
-# 3150 "parsing/parser.mly"
+# 3173 "parsing/parser.mly"
( _1 )
-# 12928 "parsing/parser.ml"
+# 12976 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (Parsetree.core_type) = Obj.magic _1 in
let _2 : unit = Obj.magic _2 in
let label : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 12977 "parsing/parser.ml"
+# 13025 "parsing/parser.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 768 "parsing/parser.mly"
+# 790 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 12987 "parsing/parser.ml"
+# 13035 "parsing/parser.ml"
in
let label =
-# 3156 "parsing/parser.mly"
+# 3179 "parsing/parser.mly"
( Labelled label )
-# 12992 "parsing/parser.ml"
+# 13040 "parsing/parser.ml"
in
-# 3148 "parsing/parser.mly"
+# 3171 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 12997 "parsing/parser.ml"
+# 13045 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13007 "parsing/parser.ml"
+# 13055 "parsing/parser.ml"
in
-# 3150 "parsing/parser.mly"
+# 3173 "parsing/parser.mly"
( _1 )
-# 13013 "parsing/parser.ml"
+# 13061 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 768 "parsing/parser.mly"
+# 790 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13054 "parsing/parser.ml"
+# 13102 "parsing/parser.ml"
in
let label =
-# 3158 "parsing/parser.mly"
+# 3181 "parsing/parser.mly"
( Nolabel )
-# 13059 "parsing/parser.ml"
+# 13107 "parsing/parser.ml"
in
-# 3148 "parsing/parser.mly"
+# 3171 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13064 "parsing/parser.ml"
+# 13112 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_codomain_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13074 "parsing/parser.ml"
+# 13122 "parsing/parser.ml"
in
-# 3150 "parsing/parser.mly"
+# 3173 "parsing/parser.mly"
( _1 )
-# 13080 "parsing/parser.ml"
+# 13128 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (string Asttypes.loc * Parsetree.module_type option) = let x =
- let _1 =
-# 1113 "parsing/parser.mly"
- ("*")
-# 13113 "parsing/parser.ml"
- in
- let _endpos__1_ = _endpos__2_ in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 770 "parsing/parser.mly"
- ( mkrhs _1 _sloc )
-# 13122 "parsing/parser.ml"
-
- in
-
-# 1114 "parsing/parser.mly"
- ( x, None )
-# 13128 "parsing/parser.ml"
+ let _v : (Parsetree.functor_parameter) =
+# 1136 "parsing/parser.mly"
+ ( Unit )
+# 13160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _5 : unit = Obj.magic _5 in
let mty : (Parsetree.module_type) = Obj.magic mty in
let _3 : unit = Obj.magic _3 in
- let _1_inlined1 : (string) = Obj.magic _1_inlined1 in
+ let _1_inlined1 : (string option) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _v : (string Asttypes.loc * Parsetree.module_type option) = let x =
+ let _v : (Parsetree.functor_parameter) = let x =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13186 "parsing/parser.ml"
+# 13218 "parsing/parser.ml"
in
-# 1117 "parsing/parser.mly"
- ( x, Some mty )
-# 13192 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = x;
- MenhirLib.EngineTypes.startp = _startpos_x_;
- MenhirLib.EngineTypes.endp = _endpos_x_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- } = _menhir_stack in
- let x : (
-# 666 "parsing/parser.mly"
- (string)
-# 13213 "parsing/parser.ml"
- ) = Obj.magic x in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos_x_ in
- let _endpos = _endpos_x_ in
- let _v : (string) =
-# 1123 "parsing/parser.mly"
- ( x )
-# 13221 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- } = _menhir_stack in
- let _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__1_ in
- let _v : (string) =
-# 1126 "parsing/parser.mly"
- ( "_" )
-# 13246 "parsing/parser.ml"
+# 1139 "parsing/parser.mly"
+ ( Named (x, mty) )
+# 13224 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 2950 "parsing/parser.mly"
+# 2973 "parsing/parser.mly"
( (Pcstr_tuple [],None) )
-# 13264 "parsing/parser.ml"
+# 13242 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 2951 "parsing/parser.mly"
+# 2974 "parsing/parser.mly"
( (_2,None) )
-# 13296 "parsing/parser.ml"
+# 13274 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 2953 "parsing/parser.mly"
+# 2976 "parsing/parser.mly"
( (_2,Some _4) )
-# 13342 "parsing/parser.ml"
+# 13320 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 2955 "parsing/parser.mly"
+# 2978 "parsing/parser.mly"
( (Pcstr_tuple [],Some _2) )
-# 13374 "parsing/parser.ml"
+# 13352 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
Docstrings.info) = let attrs =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 13424 "parsing/parser.ml"
+# 13402 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13436 "parsing/parser.ml"
+# 13414 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2898 "parsing/parser.mly"
+# 2921 "parsing/parser.mly"
(
let args, res = args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, args, res, attrs, loc, info
)
-# 13450 "parsing/parser.ml"
+# 13428 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
Docstrings.info) = let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 13493 "parsing/parser.ml"
+# 13471 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13504 "parsing/parser.ml"
+# 13482 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3465 "parsing/parser.mly"
+# 3492 "parsing/parser.mly"
( () )
-# 13511 "parsing/parser.ml"
+# 13489 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2898 "parsing/parser.mly"
+# 2921 "parsing/parser.mly"
(
let args, res = args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, args, res, attrs, loc, info
)
-# 13524 "parsing/parser.ml"
+# 13502 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 13597 "parsing/parser.ml"
+# 13575 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 13612 "parsing/parser.ml"
+# 13590 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 13621 "parsing/parser.ml"
+# 13599 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 13626 "parsing/parser.ml"
+# 13604 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 13632 "parsing/parser.ml"
+# 13610 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 2849 "parsing/parser.mly"
+# 2872 "parsing/parser.mly"
( _2 )
-# 13640 "parsing/parser.ml"
+# 13618 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13651 "parsing/parser.ml"
+# 13629 "parsing/parser.ml"
in
let flag =
-# 3485 "parsing/parser.mly"
+# 3512 "parsing/parser.mly"
( Recursive )
-# 13657 "parsing/parser.ml"
+# 13635 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 13664 "parsing/parser.ml"
+# 13642 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2786 "parsing/parser.mly"
+# 2809 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13680 "parsing/parser.ml"
+# 13658 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined4 : unit = Obj.magic _1_inlined4 in
let _1_inlined3 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 13759 "parsing/parser.ml"
+# 13737 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined5 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 13775 "parsing/parser.ml"
+# 13753 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined5_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 13784 "parsing/parser.ml"
+# 13762 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 13789 "parsing/parser.ml"
+# 13767 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 13795 "parsing/parser.ml"
+# 13773 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined4 in
-# 2849 "parsing/parser.mly"
+# 2872 "parsing/parser.mly"
( _2 )
-# 13803 "parsing/parser.ml"
+# 13781 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13814 "parsing/parser.ml"
+# 13792 "parsing/parser.ml"
in
let flag =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3486 "parsing/parser.mly"
+# 3513 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 13825 "parsing/parser.ml"
+# 13803 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 13833 "parsing/parser.ml"
+# 13811 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2786 "parsing/parser.mly"
+# 2809 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13849 "parsing/parser.ml"
+# 13827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 13915 "parsing/parser.ml"
+# 13893 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 13930 "parsing/parser.ml"
+# 13908 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 13939 "parsing/parser.ml"
+# 13917 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 13944 "parsing/parser.ml"
+# 13922 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 13950 "parsing/parser.ml"
+# 13928 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13961 "parsing/parser.ml"
+# 13939 "parsing/parser.ml"
in
let flag =
-# 3481 "parsing/parser.mly"
+# 3508 "parsing/parser.mly"
( Recursive )
-# 13967 "parsing/parser.ml"
+# 13945 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 13974 "parsing/parser.ml"
+# 13952 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2786 "parsing/parser.mly"
+# 2809 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13990 "parsing/parser.ml"
+# 13968 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined3 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14062 "parsing/parser.ml"
+# 14040 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 14078 "parsing/parser.ml"
+# 14056 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 14087 "parsing/parser.ml"
+# 14065 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 14092 "parsing/parser.ml"
+# 14070 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 14098 "parsing/parser.ml"
+# 14076 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14109 "parsing/parser.ml"
+# 14087 "parsing/parser.ml"
in
let flag =
let _1 = _1_inlined2 in
-# 3482 "parsing/parser.mly"
+# 3509 "parsing/parser.mly"
( Nonrecursive )
-# 14117 "parsing/parser.ml"
+# 14095 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 14125 "parsing/parser.ml"
+# 14103 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2786 "parsing/parser.mly"
+# 2809 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 14141 "parsing/parser.ml"
+# 14119 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 14162 "parsing/parser.ml"
+# 14140 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3342 "parsing/parser.mly"
+# 3365 "parsing/parser.mly"
( _1 )
-# 14170 "parsing/parser.ml"
+# 14148 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14191 "parsing/parser.ml"
+# 14169 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3343 "parsing/parser.mly"
+# 3366 "parsing/parser.mly"
( _1 )
-# 14199 "parsing/parser.ml"
+# 14177 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 746 "parsing/parser.mly"
+# 768 "parsing/parser.mly"
(Parsetree.structure)
-# 14231 "parsing/parser.ml"
+# 14209 "parsing/parser.ml"
) =
-# 1025 "parsing/parser.mly"
+# 1047 "parsing/parser.mly"
( _1 )
-# 14235 "parsing/parser.ml"
+# 14213 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let _menhir_s = _menhir_env.MenhirLib.EngineTypes.current in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _endpos = _startpos in
+ let _v : (string) =
+# 3412 "parsing/parser.mly"
+ ( "" )
+# 14231 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ } = _menhir_stack in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__2_ in
+ let _v : (string) =
+# 3413 "parsing/parser.mly"
+ ( ";.." )
+# 14263 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 748 "parsing/parser.mly"
+# 770 "parsing/parser.mly"
(Parsetree.signature)
-# 14267 "parsing/parser.ml"
+# 14295 "parsing/parser.ml"
) =
-# 1031 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( _1 )
-# 14271 "parsing/parser.ml"
+# 14299 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3659 "parsing/parser.mly"
+# 3686 "parsing/parser.mly"
( (_2, _3) )
-# 14317 "parsing/parser.ml"
+# 14345 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14365 "parsing/parser.ml"
+# 14393 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.label_declaration) = let _5 =
let _1 = _1_inlined3 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 14376 "parsing/parser.ml"
+# 14404 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3095 "parsing/parser.mly"
+# 3118 "parsing/parser.mly"
( _1 )
-# 14385 "parsing/parser.ml"
+# 14413 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 14393 "parsing/parser.ml"
+# 14421 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14401 "parsing/parser.ml"
+# 14429 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2972 "parsing/parser.mly"
+# 2995 "parsing/parser.mly"
( let info = symbol_info _endpos in
Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
-# 14415 "parsing/parser.ml"
+# 14443 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14477 "parsing/parser.ml"
+# 14505 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.label_declaration) = let _7 =
let _1 = _1_inlined4 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 14488 "parsing/parser.ml"
+# 14516 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _5 =
let _1 = _1_inlined3 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 14497 "parsing/parser.ml"
+# 14525 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3095 "parsing/parser.mly"
+# 3118 "parsing/parser.mly"
( _1 )
-# 14506 "parsing/parser.ml"
+# 14534 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 14514 "parsing/parser.ml"
+# 14542 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14522 "parsing/parser.ml"
+# 14550 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2977 "parsing/parser.mly"
+# 3000 "parsing/parser.mly"
( let info =
match rhs_info _endpos__5_ with
| Some _ as info_before_semi -> info_before_semi
| None -> symbol_info _endpos
in
Type.field _2 _4 ~mut:_1 ~attrs:(_5 @ _7) ~loc:(make_loc _sloc) ~info )
-# 14540 "parsing/parser.ml"
+# 14568 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 2966 "parsing/parser.mly"
+# 2989 "parsing/parser.mly"
( [_1] )
-# 14565 "parsing/parser.ml"
+# 14593 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 2967 "parsing/parser.mly"
+# 2990 "parsing/parser.mly"
( [_1] )
-# 14590 "parsing/parser.ml"
+# 14618 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.label_declaration list) =
-# 2968 "parsing/parser.mly"
+# 2991 "parsing/parser.mly"
( _1 :: _2 )
-# 14622 "parsing/parser.ml"
+# 14650 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14643 "parsing/parser.ml"
+# 14671 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14656 "parsing/parser.ml"
+# 14684 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2053 "parsing/parser.mly"
+# 2073 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14665 "parsing/parser.ml"
+# 14693 "parsing/parser.ml"
in
-# 2045 "parsing/parser.mly"
+# 2065 "parsing/parser.mly"
( x )
-# 14671 "parsing/parser.ml"
+# 14699 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.core_type) = Obj.magic cty in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14706 "parsing/parser.ml"
+# 14734 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14719 "parsing/parser.ml"
+# 14747 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2053 "parsing/parser.mly"
+# 2073 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14728 "parsing/parser.ml"
+# 14756 "parsing/parser.ml"
in
let _startpos_x_ = _startpos__1_ in
let _symbolstartpos = _startpos_x_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2047 "parsing/parser.mly"
+# 2067 "parsing/parser.mly"
( let lab, pat = x in
lab,
mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
-# 14740 "parsing/parser.ml"
+# 14768 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14761 "parsing/parser.ml"
+# 14789 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3411 "parsing/parser.mly"
+# 3438 "parsing/parser.mly"
( Lident _1 )
-# 14769 "parsing/parser.ml"
+# 14797 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14802 "parsing/parser.ml"
+# 14830 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3412 "parsing/parser.mly"
+# 3439 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 14812 "parsing/parser.ml"
+# 14840 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2327 "parsing/parser.mly"
+# 2350 "parsing/parser.mly"
( (Nolabel, _1) )
-# 14837 "parsing/parser.ml"
+# 14865 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 607 "parsing/parser.mly"
+# 629 "parsing/parser.mly"
(string)
-# 14865 "parsing/parser.ml"
+# 14893 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2329 "parsing/parser.mly"
+# 2352 "parsing/parser.mly"
( (Labelled _1, _2) )
-# 14873 "parsing/parser.ml"
+# 14901 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let label : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14900 "parsing/parser.ml"
+# 14928 "parsing/parser.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2331 "parsing/parser.mly"
+# 2354 "parsing/parser.mly"
( let loc = _loc_label_ in
(Labelled label, mkexpvar ~loc label) )
-# 14911 "parsing/parser.ml"
+# 14939 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let label : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 14938 "parsing/parser.ml"
+# 14966 "parsing/parser.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2334 "parsing/parser.mly"
+# 2357 "parsing/parser.mly"
( let loc = _loc_label_ in
(Optional label, mkexpvar ~loc label) )
-# 14949 "parsing/parser.ml"
+# 14977 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 637 "parsing/parser.mly"
+# 659 "parsing/parser.mly"
(string)
-# 14977 "parsing/parser.ml"
+# 15005 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2337 "parsing/parser.mly"
+# 2360 "parsing/parser.mly"
( (Optional _1, _2) )
-# 14985 "parsing/parser.ml"
+# 15013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2041 "parsing/parser.mly"
+# 2061 "parsing/parser.mly"
( _1 )
-# 15040 "parsing/parser.ml"
+# 15068 "parsing/parser.ml"
in
-# 2015 "parsing/parser.mly"
+# 2035 "parsing/parser.mly"
( (Optional (fst _3), _4, snd _3) )
-# 15046 "parsing/parser.ml"
+# 15074 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 15073 "parsing/parser.ml"
+# 15101 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15088 "parsing/parser.ml"
+# 15116 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2053 "parsing/parser.mly"
+# 2073 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15097 "parsing/parser.ml"
+# 15125 "parsing/parser.ml"
in
-# 2017 "parsing/parser.mly"
+# 2037 "parsing/parser.mly"
( (Optional (fst _2), None, snd _2) )
-# 15103 "parsing/parser.ml"
+# 15131 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (Parsetree.pattern) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 637 "parsing/parser.mly"
+# 659 "parsing/parser.mly"
(string)
-# 15152 "parsing/parser.ml"
+# 15180 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2041 "parsing/parser.mly"
+# 2061 "parsing/parser.mly"
( _1 )
-# 15162 "parsing/parser.ml"
+# 15190 "parsing/parser.ml"
in
-# 2019 "parsing/parser.mly"
+# 2039 "parsing/parser.mly"
( (Optional _1, _4, _3) )
-# 15168 "parsing/parser.ml"
+# 15196 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 637 "parsing/parser.mly"
+# 659 "parsing/parser.mly"
(string)
-# 15196 "parsing/parser.ml"
+# 15224 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2021 "parsing/parser.mly"
+# 2041 "parsing/parser.mly"
( (Optional _1, None, _2) )
-# 15204 "parsing/parser.ml"
+# 15232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2023 "parsing/parser.mly"
+# 2043 "parsing/parser.mly"
( (Labelled (fst _3), None, snd _3) )
-# 15250 "parsing/parser.ml"
+# 15278 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 15277 "parsing/parser.ml"
+# 15305 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15292 "parsing/parser.ml"
+# 15320 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2053 "parsing/parser.mly"
+# 2073 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15301 "parsing/parser.ml"
+# 15329 "parsing/parser.ml"
in
-# 2025 "parsing/parser.mly"
+# 2045 "parsing/parser.mly"
( (Labelled (fst _2), None, snd _2) )
-# 15307 "parsing/parser.ml"
+# 15335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 607 "parsing/parser.mly"
+# 629 "parsing/parser.mly"
(string)
-# 15335 "parsing/parser.ml"
+# 15363 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2027 "parsing/parser.mly"
+# 2047 "parsing/parser.mly"
( (Labelled _1, None, _2) )
-# 15343 "parsing/parser.ml"
+# 15371 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2029 "parsing/parser.mly"
+# 2049 "parsing/parser.mly"
( (Nolabel, None, _1) )
-# 15368 "parsing/parser.ml"
+# 15396 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2344 "parsing/parser.mly"
+# 2367 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15404 "parsing/parser.ml"
+# 15432 "parsing/parser.ml"
in
-# 2348 "parsing/parser.mly"
+# 2371 "parsing/parser.mly"
( (_1, _2) )
-# 15410 "parsing/parser.ml"
+# 15438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2344 "parsing/parser.mly"
+# 2367 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15460 "parsing/parser.ml"
+# 15488 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2350 "parsing/parser.mly"
+# 2373 "parsing/parser.mly"
( let v = _1 in (* PR#7344 *)
let t =
match _2 with
let patloc = (_startpos__1_, _endpos__2_) in
(ghpat ~loc:patloc (Ppat_constraint(v, typ)),
mkexp_constraint ~loc:_sloc _4 _2) )
-# 15480 "parsing/parser.ml"
+# 15508 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 15549 "parsing/parser.ml"
+# 15577 "parsing/parser.ml"
in
-# 872 "parsing/parser.mly"
+# 894 "parsing/parser.mly"
( xs )
-# 15554 "parsing/parser.ml"
+# 15582 "parsing/parser.ml"
in
-# 3077 "parsing/parser.mly"
+# 3100 "parsing/parser.mly"
( _1 )
-# 15560 "parsing/parser.ml"
+# 15588 "parsing/parser.ml"
in
let _startpos__3_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2344 "parsing/parser.mly"
+# 2367 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15571 "parsing/parser.ml"
+# 15599 "parsing/parser.ml"
in
-# 2366 "parsing/parser.mly"
+# 2389 "parsing/parser.mly"
( let typloc = (_startpos__3_, _endpos__5_) in
let patloc = (_startpos__1_, _endpos__5_) in
(ghpat ~loc:patloc
(Ppat_constraint(_1, ghtyp ~loc:typloc (Ptyp_poly(_3,_5)))),
_7) )
-# 15581 "parsing/parser.ml"
+# 15609 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__8_ in
let _v : (Parsetree.pattern * Parsetree.expression) = let _4 =
-# 2341 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( xs )
-# 15655 "parsing/parser.ml"
+# 15683 "parsing/parser.ml"
in
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2344 "parsing/parser.mly"
+# 2367 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15664 "parsing/parser.ml"
+# 15692 "parsing/parser.ml"
in
let _endpos = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2372 "parsing/parser.mly"
+# 2395 "parsing/parser.mly"
( let exp, poly =
wrap_type_annotation ~loc:_sloc _4 _6 _8 in
let loc = (_startpos__1_, _endpos__6_) in
(ghpat ~loc (Ppat_constraint(_1, poly)), exp) )
-# 15676 "parsing/parser.ml"
+# 15704 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2377 "parsing/parser.mly"
+# 2400 "parsing/parser.mly"
( (_1, _3) )
-# 15715 "parsing/parser.ml"
+# 15743 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2379 "parsing/parser.mly"
+# 2402 "parsing/parser.mly"
( let loc = (_startpos__1_, _endpos__3_) in
(ghpat ~loc (Ppat_constraint(_1, _3)), _5) )
-# 15769 "parsing/parser.ml"
+# 15797 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 15832 "parsing/parser.ml"
+# 15860 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 15841 "parsing/parser.ml"
+# 15869 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2395 "parsing/parser.mly"
+# 2418 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 15853 "parsing/parser.ml"
+# 15881 "parsing/parser.ml"
in
-# 2385 "parsing/parser.mly"
+# 2408 "parsing/parser.mly"
( _1 )
-# 15859 "parsing/parser.ml"
+# 15887 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2386 "parsing/parser.mly"
+# 2409 "parsing/parser.mly"
( addlb _1 _2 )
-# 15891 "parsing/parser.ml"
+# 15919 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 15947 "parsing/parser.ml"
+# 15975 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 15956 "parsing/parser.ml"
+# 15984 "parsing/parser.ml"
in
let ext =
-# 3649 "parsing/parser.mly"
+# 3676 "parsing/parser.mly"
( None )
-# 15962 "parsing/parser.ml"
+# 15990 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2395 "parsing/parser.mly"
+# 2418 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 15973 "parsing/parser.ml"
+# 16001 "parsing/parser.ml"
in
-# 2385 "parsing/parser.mly"
+# 2408 "parsing/parser.mly"
( _1 )
-# 15979 "parsing/parser.ml"
+# 16007 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 16049 "parsing/parser.ml"
+# 16077 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 16058 "parsing/parser.ml"
+# 16086 "parsing/parser.ml"
in
let ext =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3650 "parsing/parser.mly"
+# 3677 "parsing/parser.mly"
( not_expecting _loc "extension" )
-# 16069 "parsing/parser.ml"
+# 16097 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2395 "parsing/parser.mly"
+# 2418 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 16081 "parsing/parser.ml"
+# 16109 "parsing/parser.ml"
in
-# 2385 "parsing/parser.mly"
+# 2408 "parsing/parser.mly"
( _1 )
-# 16087 "parsing/parser.ml"
+# 16115 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2386 "parsing/parser.mly"
+# 2409 "parsing/parser.mly"
( addlb _1 _2 )
-# 16119 "parsing/parser.ml"
+# 16147 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2057 "parsing/parser.mly"
+# 2077 "parsing/parser.mly"
( _1 )
-# 16144 "parsing/parser.ml"
+# 16172 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2059 "parsing/parser.mly"
+# 2079 "parsing/parser.mly"
( Ppat_constraint(_1, _3) )
-# 16184 "parsing/parser.ml"
+# 16212 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 16193 "parsing/parser.ml"
+# 16221 "parsing/parser.ml"
in
-# 2060 "parsing/parser.mly"
+# 2080 "parsing/parser.mly"
( _1 )
-# 16199 "parsing/parser.ml"
+# 16227 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2344 "parsing/parser.mly"
+# 2367 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 16235 "parsing/parser.ml"
+# 16263 "parsing/parser.ml"
in
-# 2412 "parsing/parser.mly"
+# 2435 "parsing/parser.mly"
( (pat, exp) )
-# 16241 "parsing/parser.ml"
+# 16269 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2414 "parsing/parser.mly"
+# 2437 "parsing/parser.mly"
( let loc = (_startpos_pat_, _endpos_typ_) in
(ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
-# 16295 "parsing/parser.ml"
+# 16323 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2417 "parsing/parser.mly"
+# 2440 "parsing/parser.mly"
( (pat, exp) )
-# 16334 "parsing/parser.ml"
+# 16362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_body_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) =
-# 2421 "parsing/parser.mly"
+# 2444 "parsing/parser.mly"
( let let_pat, let_exp = body in
let_pat, let_exp, [] )
-# 16360 "parsing/parser.ml"
+# 16388 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
let _1 : (
-# 603 "parsing/parser.mly"
+# 625 "parsing/parser.mly"
(string)
-# 16394 "parsing/parser.ml"
+# 16422 "parsing/parser.ml"
) = Obj.magic _1 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16407 "parsing/parser.ml"
+# 16435 "parsing/parser.ml"
in
let _endpos = _endpos_body_ in
let _symbolstartpos = _startpos_bindings_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2424 "parsing/parser.mly"
+# 2447 "parsing/parser.mly"
( let let_pat, let_exp, rev_ands = bindings in
let pbop_pat, pbop_exp = body in
let pbop_loc = make_loc _sloc in
let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
let_pat, let_exp, and_ :: rev_ands )
-# 16420 "parsing/parser.ml"
+# 16448 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_declaration list) =
# 211 "menhir/standard.mly"
( [] )
-# 16438 "parsing/parser.ml"
+# 16466 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 16504 "parsing/parser.ml"
+# 16532 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 16519 "parsing/parser.ml"
+# 16547 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16531 "parsing/parser.ml"
+# 16559 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 16539 "parsing/parser.ml"
+# 16567 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1661 "parsing/parser.mly"
+# 1681 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16554 "parsing/parser.ml"
+# 16582 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 16560 "parsing/parser.ml"
+# 16588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_description list) =
# 211 "menhir/standard.mly"
( [] )
-# 16578 "parsing/parser.ml"
+# 16606 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.class_type) = Obj.magic cty in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 16651 "parsing/parser.ml"
+# 16679 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 16666 "parsing/parser.ml"
+# 16694 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16678 "parsing/parser.ml"
+# 16706 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 16686 "parsing/parser.ml"
+# 16714 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1952 "parsing/parser.mly"
+# 1972 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16701 "parsing/parser.ml"
+# 16729 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 16707 "parsing/parser.ml"
+# 16735 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_declaration list) =
# 211 "menhir/standard.mly"
( [] )
-# 16725 "parsing/parser.ml"
+# 16753 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let csig : (Parsetree.class_type) = Obj.magic csig in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 16798 "parsing/parser.ml"
+# 16826 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 16813 "parsing/parser.ml"
+# 16841 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16825 "parsing/parser.ml"
+# 16853 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 16833 "parsing/parser.ml"
+# 16861 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1991 "parsing/parser.mly"
+# 2011 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16848 "parsing/parser.ml"
+# 16876 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 16854 "parsing/parser.ml"
+# 16882 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_binding list) =
# 211 "menhir/standard.mly"
( [] )
-# 16872 "parsing/parser.ml"
+# 16900 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : (Parsetree.module_binding list) = Obj.magic xs in
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.module_expr) = Obj.magic body in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 16926 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 16939 "parsing/parser.ml"
+# 16963 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16951 "parsing/parser.ml"
+# 16975 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 16959 "parsing/parser.ml"
+# 16983 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1342 "parsing/parser.mly"
+# 1363 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
- Mb.mk uid body ~attrs ~loc ~text ~docs
+ Mb.mk name body ~attrs ~loc ~text ~docs
)
-# 16974 "parsing/parser.ml"
+# 16998 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 16980 "parsing/parser.ml"
+# 17004 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_declaration list) =
# 211 "menhir/standard.mly"
( [] )
-# 16998 "parsing/parser.ml"
+# 17022 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let mty : (Parsetree.module_type) = Obj.magic mty in
let _4 : unit = Obj.magic _4 in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 17059 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 17072 "parsing/parser.ml"
+# 17092 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17084 "parsing/parser.ml"
+# 17104 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 17092 "parsing/parser.ml"
+# 17112 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1619 "parsing/parser.mly"
+# 1639 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs _sloc in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
- Md.mk uid mty ~attrs ~loc ~text ~docs
+ Md.mk name mty ~attrs ~loc ~text ~docs
)
-# 17107 "parsing/parser.ml"
+# 17127 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17113 "parsing/parser.ml"
+# 17133 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "menhir/standard.mly"
( [] )
-# 17131 "parsing/parser.ml"
+# 17151 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "menhir/standard.mly"
( x :: xs )
-# 17163 "parsing/parser.ml"
+# 17183 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "menhir/standard.mly"
( [] )
-# 17181 "parsing/parser.ml"
+# 17201 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 17248 "parsing/parser.ml"
+# 17268 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 17263 "parsing/parser.ml"
+# 17283 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 17272 "parsing/parser.ml"
+# 17292 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 17277 "parsing/parser.ml"
+# 17297 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 17283 "parsing/parser.ml"
+# 17303 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17294 "parsing/parser.ml"
+# 17314 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 17302 "parsing/parser.ml"
+# 17322 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2803 "parsing/parser.mly"
+# 2826 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 17318 "parsing/parser.ml"
+# 17338 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17324 "parsing/parser.ml"
+# 17344 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "menhir/standard.mly"
( [] )
-# 17342 "parsing/parser.ml"
+# 17362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 17416 "parsing/parser.ml"
+# 17436 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 17431 "parsing/parser.ml"
+# 17451 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 17440 "parsing/parser.ml"
+# 17460 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 17445 "parsing/parser.ml"
+# 17465 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 17451 "parsing/parser.ml"
+# 17471 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 2849 "parsing/parser.mly"
+# 2872 "parsing/parser.mly"
( _2 )
-# 17459 "parsing/parser.ml"
+# 17479 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17470 "parsing/parser.ml"
+# 17490 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 17478 "parsing/parser.ml"
+# 17498 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2803 "parsing/parser.mly"
+# 2826 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 17494 "parsing/parser.ml"
+# 17514 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17500 "parsing/parser.ml"
+# 17520 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "menhir/standard.mly"
( [] )
-# 17518 "parsing/parser.ml"
+# 17538 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "menhir/standard.mly"
( x :: xs )
-# 17550 "parsing/parser.ml"
+# 17570 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item list list) =
# 211 "menhir/standard.mly"
( [] )
-# 17568 "parsing/parser.ml"
+# 17588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 780 "parsing/parser.mly"
+# 802 "parsing/parser.mly"
( text_sig _startpos )
-# 17603 "parsing/parser.ml"
+# 17623 "parsing/parser.ml"
in
-# 1480 "parsing/parser.mly"
+# 1501 "parsing/parser.mly"
( _1 )
-# 17609 "parsing/parser.ml"
+# 17629 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17615 "parsing/parser.ml"
+# 17635 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 778 "parsing/parser.mly"
+# 800 "parsing/parser.mly"
( text_sig _startpos @ [_1] )
-# 17650 "parsing/parser.ml"
+# 17670 "parsing/parser.ml"
in
-# 1480 "parsing/parser.mly"
+# 1501 "parsing/parser.mly"
( _1 )
-# 17656 "parsing/parser.ml"
+# 17676 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17662 "parsing/parser.ml"
+# 17682 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "menhir/standard.mly"
( [] )
-# 17680 "parsing/parser.ml"
+# 17700 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let ys =
let items =
-# 840 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( [] )
-# 17715 "parsing/parser.ml"
+# 17735 "parsing/parser.ml"
in
-# 1225 "parsing/parser.mly"
+# 1247 "parsing/parser.mly"
( items )
-# 17720 "parsing/parser.ml"
+# 17740 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 776 "parsing/parser.mly"
+# 798 "parsing/parser.mly"
( text_str _startpos )
-# 17728 "parsing/parser.ml"
+# 17748 "parsing/parser.ml"
in
# 267 "menhir/standard.mly"
( xs @ ys )
-# 17734 "parsing/parser.ml"
+# 17754 "parsing/parser.ml"
in
-# 1241 "parsing/parser.mly"
+# 1263 "parsing/parser.mly"
( _1 )
-# 17740 "parsing/parser.ml"
+# 17760 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17746 "parsing/parser.ml"
+# 17766 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 17800 "parsing/parser.ml"
+# 17820 "parsing/parser.ml"
in
-# 1232 "parsing/parser.mly"
+# 1254 "parsing/parser.mly"
( mkstrexp e attrs )
-# 17805 "parsing/parser.ml"
+# 17825 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 774 "parsing/parser.mly"
+# 796 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 17813 "parsing/parser.ml"
+# 17833 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 793 "parsing/parser.mly"
+# 815 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 17823 "parsing/parser.ml"
+# 17843 "parsing/parser.ml"
in
-# 842 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( x )
-# 17829 "parsing/parser.ml"
+# 17849 "parsing/parser.ml"
in
-# 1225 "parsing/parser.mly"
+# 1247 "parsing/parser.mly"
( items )
-# 17835 "parsing/parser.ml"
+# 17855 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 776 "parsing/parser.mly"
+# 798 "parsing/parser.mly"
( text_str _startpos )
-# 17843 "parsing/parser.ml"
+# 17863 "parsing/parser.ml"
in
# 267 "menhir/standard.mly"
( xs @ ys )
-# 17849 "parsing/parser.ml"
+# 17869 "parsing/parser.ml"
in
-# 1241 "parsing/parser.mly"
+# 1263 "parsing/parser.mly"
( _1 )
-# 17855 "parsing/parser.ml"
+# 17875 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17861 "parsing/parser.ml"
+# 17881 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 774 "parsing/parser.mly"
+# 796 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 17896 "parsing/parser.ml"
+# 17916 "parsing/parser.ml"
in
-# 1241 "parsing/parser.mly"
+# 1263 "parsing/parser.mly"
( _1 )
-# 17902 "parsing/parser.ml"
+# 17922 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17908 "parsing/parser.ml"
+# 17928 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) =
# 211 "menhir/standard.mly"
( [] )
-# 17926 "parsing/parser.ml"
+# 17946 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) = let x =
let _startpos = _startpos__1_ in
-# 788 "parsing/parser.mly"
+# 810 "parsing/parser.mly"
( text_csig _startpos @ [_1] )
-# 17960 "parsing/parser.ml"
+# 17980 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 17966 "parsing/parser.ml"
+# 17986 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) =
# 211 "menhir/standard.mly"
( [] )
-# 17984 "parsing/parser.ml"
+# 18004 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) = let x =
let _startpos = _startpos__1_ in
-# 786 "parsing/parser.mly"
+# 808 "parsing/parser.mly"
( text_cstr _startpos @ [_1] )
-# 18018 "parsing/parser.ml"
+# 18038 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 18024 "parsing/parser.ml"
+# 18044 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "menhir/standard.mly"
( [] )
-# 18042 "parsing/parser.ml"
+# 18062 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) = let x =
let _startpos = _startpos__1_ in
-# 774 "parsing/parser.mly"
+# 796 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 18076 "parsing/parser.ml"
+# 18096 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 18082 "parsing/parser.ml"
+# 18102 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) =
# 211 "menhir/standard.mly"
( [] )
-# 18100 "parsing/parser.ml"
+# 18120 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let x =
let _1 =
-# 840 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( [] )
-# 18135 "parsing/parser.ml"
+# 18155 "parsing/parser.ml"
in
-# 1070 "parsing/parser.mly"
+# 1092 "parsing/parser.mly"
( _1 )
-# 18140 "parsing/parser.ml"
+# 18160 "parsing/parser.ml"
in
# 183 "menhir/standard.mly"
( x )
-# 18146 "parsing/parser.ml"
+# 18166 "parsing/parser.ml"
in
-# 1082 "parsing/parser.mly"
+# 1104 "parsing/parser.mly"
( _1 )
-# 18152 "parsing/parser.ml"
+# 18172 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 18158 "parsing/parser.ml"
+# 18178 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 18212 "parsing/parser.ml"
+# 18232 "parsing/parser.ml"
in
-# 1232 "parsing/parser.mly"
+# 1254 "parsing/parser.mly"
( mkstrexp e attrs )
-# 18217 "parsing/parser.ml"
+# 18237 "parsing/parser.ml"
in
-# 784 "parsing/parser.mly"
+# 806 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18223 "parsing/parser.ml"
+# 18243 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 782 "parsing/parser.mly"
+# 804 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18231 "parsing/parser.ml"
+# 18251 "parsing/parser.ml"
in
-# 842 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( x )
-# 18237 "parsing/parser.ml"
+# 18257 "parsing/parser.ml"
in
-# 1070 "parsing/parser.mly"
+# 1092 "parsing/parser.mly"
( _1 )
-# 18243 "parsing/parser.ml"
+# 18263 "parsing/parser.ml"
in
# 183 "menhir/standard.mly"
( x )
-# 18249 "parsing/parser.ml"
+# 18269 "parsing/parser.ml"
in
-# 1082 "parsing/parser.mly"
+# 1104 "parsing/parser.mly"
( _1 )
-# 18255 "parsing/parser.ml"
+# 18275 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 18261 "parsing/parser.ml"
+# 18281 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) = let x =
let _1 =
let _1 =
-# 784 "parsing/parser.mly"
+# 806 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18295 "parsing/parser.ml"
+# 18315 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 782 "parsing/parser.mly"
+# 804 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18301 "parsing/parser.ml"
+# 18321 "parsing/parser.ml"
in
-# 1082 "parsing/parser.mly"
+# 1104 "parsing/parser.mly"
( _1 )
-# 18307 "parsing/parser.ml"
+# 18327 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 18313 "parsing/parser.ml"
+# 18333 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 793 "parsing/parser.mly"
+# 815 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 18351 "parsing/parser.ml"
+# 18371 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 782 "parsing/parser.mly"
+# 804 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18358 "parsing/parser.ml"
+# 18378 "parsing/parser.ml"
in
-# 1082 "parsing/parser.mly"
+# 1104 "parsing/parser.mly"
( _1 )
-# 18364 "parsing/parser.ml"
+# 18384 "parsing/parser.ml"
in
# 213 "menhir/standard.mly"
( x :: xs )
-# 18370 "parsing/parser.ml"
+# 18390 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 =
# 124 "menhir/standard.mly"
( None )
-# 18409 "parsing/parser.ml"
+# 18429 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18419 "parsing/parser.ml"
+# 18439 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2692 "parsing/parser.mly"
+# 2715 "parsing/parser.mly"
( let pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18438 "parsing/parser.ml"
+# 18458 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1031 "parsing/parser.mly"
( [x], None )
-# 18444 "parsing/parser.ml"
+# 18464 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 =
# 126 "menhir/standard.mly"
( Some x )
-# 18490 "parsing/parser.ml"
+# 18510 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18500 "parsing/parser.ml"
+# 18520 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2692 "parsing/parser.mly"
+# 2715 "parsing/parser.mly"
( let pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18519 "parsing/parser.ml"
+# 18539 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1031 "parsing/parser.mly"
( [x], None )
-# 18525 "parsing/parser.ml"
+# 18545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18590 "parsing/parser.ml"
+# 18610 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2692 "parsing/parser.mly"
+# 2715 "parsing/parser.mly"
( let pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18609 "parsing/parser.ml"
+# 18629 "parsing/parser.ml"
in
-# 1011 "parsing/parser.mly"
+# 1033 "parsing/parser.mly"
( [x], Some y )
-# 18615 "parsing/parser.ml"
+# 18635 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18673 "parsing/parser.ml"
+# 18693 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2692 "parsing/parser.mly"
+# 2715 "parsing/parser.mly"
( let pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18692 "parsing/parser.ml"
+# 18712 "parsing/parser.ml"
in
-# 1015 "parsing/parser.mly"
+# 1037 "parsing/parser.mly"
( let xs, y = tail in
x :: xs, y )
-# 18699 "parsing/parser.ml"
+# 18719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) =
-# 2450 "parsing/parser.mly"
+# 2473 "parsing/parser.mly"
( Exp.case _1 _3 )
-# 18738 "parsing/parser.ml"
+# 18758 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.case) =
-# 2452 "parsing/parser.mly"
+# 2475 "parsing/parser.mly"
( Exp.case _1 ~guard:_3 _5 )
-# 18791 "parsing/parser.ml"
+# 18811 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2454 "parsing/parser.mly"
+# 2477 "parsing/parser.mly"
( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) )
-# 18831 "parsing/parser.ml"
+# 18851 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 18894 "parsing/parser.ml"
+# 18914 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _6 =
let _1 = _1_inlined3 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 18905 "parsing/parser.ml"
+# 18925 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 18914 "parsing/parser.ml"
+# 18934 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3095 "parsing/parser.mly"
+# 3118 "parsing/parser.mly"
( _1 )
-# 18923 "parsing/parser.ml"
+# 18943 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 18930 "parsing/parser.ml"
+# 18950 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18938 "parsing/parser.ml"
+# 18958 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3305 "parsing/parser.mly"
+# 3328 "parsing/parser.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 18953 "parsing/parser.ml"
+# 18973 "parsing/parser.ml"
in
-# 3286 "parsing/parser.mly"
+# 3309 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 18959 "parsing/parser.ml"
+# 18979 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3316 "parsing/parser.mly"
+# 3339 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19002 "parsing/parser.ml"
+# 19022 "parsing/parser.ml"
in
-# 3286 "parsing/parser.mly"
+# 3309 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 19008 "parsing/parser.ml"
+# 19028 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19064 "parsing/parser.ml"
+# 19084 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _6 =
let _1 = _1_inlined3 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19075 "parsing/parser.ml"
+# 19095 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19084 "parsing/parser.ml"
+# 19104 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3095 "parsing/parser.mly"
+# 3118 "parsing/parser.mly"
( _1 )
-# 19093 "parsing/parser.ml"
+# 19113 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19100 "parsing/parser.ml"
+# 19120 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19108 "parsing/parser.ml"
+# 19128 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3305 "parsing/parser.mly"
+# 3328 "parsing/parser.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 19123 "parsing/parser.ml"
+# 19143 "parsing/parser.ml"
in
-# 3289 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( [head], Closed )
-# 19129 "parsing/parser.ml"
+# 19149 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3316 "parsing/parser.mly"
+# 3339 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19165 "parsing/parser.ml"
+# 19185 "parsing/parser.ml"
in
-# 3289 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( [head], Closed )
-# 19171 "parsing/parser.ml"
+# 19191 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19213 "parsing/parser.ml"
+# 19233 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _4 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19224 "parsing/parser.ml"
+# 19244 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3095 "parsing/parser.mly"
+# 3118 "parsing/parser.mly"
( _1 )
-# 19233 "parsing/parser.ml"
+# 19253 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19240 "parsing/parser.ml"
+# 19260 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19248 "parsing/parser.ml"
+# 19268 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3298 "parsing/parser.mly"
+# 3321 "parsing/parser.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _4 in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 19259 "parsing/parser.ml"
+# 19279 "parsing/parser.ml"
in
-# 3292 "parsing/parser.mly"
+# 3315 "parsing/parser.mly"
( [head], Closed )
-# 19265 "parsing/parser.ml"
+# 19285 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3316 "parsing/parser.mly"
+# 3339 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19294 "parsing/parser.ml"
+# 19314 "parsing/parser.ml"
in
-# 3292 "parsing/parser.mly"
+# 3315 "parsing/parser.mly"
( [head], Closed )
-# 19300 "parsing/parser.ml"
+# 19320 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.object_field list * Asttypes.closed_flag) =
-# 3294 "parsing/parser.mly"
+# 3317 "parsing/parser.mly"
( [], Open )
-# 19325 "parsing/parser.ml"
+# 19345 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19372 "parsing/parser.ml"
+# 19392 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let private_ : (Asttypes.private_flag) = Obj.magic private_ in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let ty =
let _1 = _1_inlined2 in
-# 3091 "parsing/parser.mly"
+# 3114 "parsing/parser.mly"
( _1 )
-# 19386 "parsing/parser.ml"
+# 19406 "parsing/parser.ml"
in
let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19394 "parsing/parser.ml"
+# 19414 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19402 "parsing/parser.ml"
+# 19422 "parsing/parser.ml"
in
let attrs =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19408 "parsing/parser.ml"
+# 19428 "parsing/parser.ml"
in
let _1 =
-# 3541 "parsing/parser.mly"
+# 3568 "parsing/parser.mly"
( Fresh )
-# 19413 "parsing/parser.ml"
+# 19433 "parsing/parser.ml"
in
-# 1799 "parsing/parser.mly"
+# 1819 "parsing/parser.mly"
( (label, private_, Cfk_virtual ty), attrs )
-# 19418 "parsing/parser.ml"
+# 19438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19458 "parsing/parser.ml"
+# 19478 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19472 "parsing/parser.ml"
+# 19492 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19480 "parsing/parser.ml"
+# 19500 "parsing/parser.ml"
in
let _2 =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19486 "parsing/parser.ml"
+# 19506 "parsing/parser.ml"
in
let _1 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 19491 "parsing/parser.ml"
+# 19511 "parsing/parser.ml"
in
-# 1801 "parsing/parser.mly"
+# 1821 "parsing/parser.mly"
( let e = _5 in
let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
(_4, _3,
Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 19499 "parsing/parser.ml"
+# 19519 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19545 "parsing/parser.ml"
+# 19565 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19560 "parsing/parser.ml"
+# 19580 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19568 "parsing/parser.ml"
+# 19588 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19576 "parsing/parser.ml"
+# 19596 "parsing/parser.ml"
in
let _1 =
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 19582 "parsing/parser.ml"
+# 19602 "parsing/parser.ml"
in
-# 1801 "parsing/parser.mly"
+# 1821 "parsing/parser.mly"
( let e = _5 in
let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
(_4, _3,
Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 19590 "parsing/parser.ml"
+# 19610 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19651 "parsing/parser.ml"
+# 19671 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _6 =
let _1 = _1_inlined2 in
-# 3091 "parsing/parser.mly"
+# 3114 "parsing/parser.mly"
( _1 )
-# 19665 "parsing/parser.ml"
+# 19685 "parsing/parser.ml"
in
let _startpos__6_ = _startpos__1_inlined2_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19674 "parsing/parser.ml"
+# 19694 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19682 "parsing/parser.ml"
+# 19702 "parsing/parser.ml"
in
let _2 =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19688 "parsing/parser.ml"
+# 19708 "parsing/parser.ml"
in
let _1 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 19693 "parsing/parser.ml"
+# 19713 "parsing/parser.ml"
in
-# 1807 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
( let poly_exp =
let loc = (_startpos__6_, _endpos__8_) in
ghexp ~loc (Pexp_poly(_8, Some _6)) in
(_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 19701 "parsing/parser.ml"
+# 19721 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19768 "parsing/parser.ml"
+# 19788 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _6 =
let _1 = _1_inlined3 in
-# 3091 "parsing/parser.mly"
+# 3114 "parsing/parser.mly"
( _1 )
-# 19783 "parsing/parser.ml"
+# 19803 "parsing/parser.ml"
in
let _startpos__6_ = _startpos__1_inlined3_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19792 "parsing/parser.ml"
+# 19812 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19800 "parsing/parser.ml"
+# 19820 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19808 "parsing/parser.ml"
+# 19828 "parsing/parser.ml"
in
let _1 =
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 19814 "parsing/parser.ml"
+# 19834 "parsing/parser.ml"
in
-# 1807 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
( let poly_exp =
let loc = (_startpos__6_, _endpos__8_) in
ghexp ~loc (Pexp_poly(_8, Some _6)) in
(_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 19822 "parsing/parser.ml"
+# 19842 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 19904 "parsing/parser.ml"
+# 19924 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2341 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( xs )
-# 19916 "parsing/parser.ml"
+# 19936 "parsing/parser.ml"
in
let _startpos__7_ = _startpos_xs_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 19924 "parsing/parser.ml"
+# 19944 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19932 "parsing/parser.ml"
+# 19952 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 19939 "parsing/parser.ml"
+# 19959 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 19945 "parsing/parser.ml"
+# 19965 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__11_ in
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1813 "parsing/parser.mly"
+# 1833 "parsing/parser.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 19972 "parsing/parser.ml"
+# 19992 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 20060 "parsing/parser.ml"
+# 20080 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2341 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( xs )
-# 20073 "parsing/parser.ml"
+# 20093 "parsing/parser.ml"
in
let _startpos__7_ = _startpos_xs_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 20081 "parsing/parser.ml"
+# 20101 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20089 "parsing/parser.ml"
+# 20109 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 20098 "parsing/parser.ml"
+# 20118 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 20105 "parsing/parser.ml"
+# 20125 "parsing/parser.ml"
in
let _endpos = _endpos__11_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1813 "parsing/parser.mly"
+# 1833 "parsing/parser.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 20131 "parsing/parser.ml"
+# 20151 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 20152 "parsing/parser.ml"
+# 20172 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3423 "parsing/parser.mly"
+# 3450 "parsing/parser.mly"
( Lident _1 )
-# 20160 "parsing/parser.ml"
+# 20180 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 20193 "parsing/parser.ml"
+# 20213 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3424 "parsing/parser.mly"
+# 3451 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 20203 "parsing/parser.ml"
+# 20223 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3426 "parsing/parser.mly"
+# 3453 "parsing/parser.mly"
( lapply ~loc:_sloc _1 _3 )
-# 20252 "parsing/parser.ml"
+# 20272 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3428 "parsing/parser.mly"
+# 3455 "parsing/parser.mly"
( expecting _loc__3_ "module path" )
-# 20292 "parsing/parser.ml"
+# 20312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 20313 "parsing/parser.ml"
+# 20333 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3419 "parsing/parser.mly"
+# 3446 "parsing/parser.mly"
( Lident _1 )
-# 20321 "parsing/parser.ml"
+# 20341 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 20354 "parsing/parser.ml"
+# 20374 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3420 "parsing/parser.mly"
+# 3447 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 20364 "parsing/parser.ml"
+# 20384 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1301 "parsing/parser.mly"
+# 1323 "parsing/parser.mly"
( me )
-# 20396 "parsing/parser.ml"
+# 20416 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1304 "parsing/parser.mly"
+# 1326 "parsing/parser.mly"
( Pmod_constraint(me, mty) )
-# 20443 "parsing/parser.ml"
+# 20463 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_me_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 20452 "parsing/parser.ml"
+# 20472 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( _1 )
-# 20458 "parsing/parser.ml"
+# 20478 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let body : (Parsetree.module_expr) = Obj.magic body in
- let arg : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic arg in
+ let arg : (Parsetree.functor_parameter) = Obj.magic arg in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_arg_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1306 "parsing/parser.mly"
- ( let (x, mty) = arg in
- Pmod_functor(x, mty, body) )
-# 20492 "parsing/parser.ml"
+# 1328 "parsing/parser.mly"
+ ( Pmod_functor(arg, body) )
+# 20511 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 20501 "parsing/parser.ml"
+# 20520 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( _1 )
-# 20507 "parsing/parser.ml"
+# 20526 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_mty_ in
let _v : (Parsetree.module_type) =
-# 1545 "parsing/parser.mly"
+# 1566 "parsing/parser.mly"
( mty )
-# 20539 "parsing/parser.ml"
+# 20558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let body : (Parsetree.module_type) = Obj.magic body in
- let arg : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic arg in
+ let arg : (Parsetree.functor_parameter) = Obj.magic arg in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_arg_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1548 "parsing/parser.mly"
- ( let (x, mty) = arg in
- Pmty_functor(x, mty, body) )
-# 20573 "parsing/parser.ml"
+# 1569 "parsing/parser.mly"
+ ( Pmty_functor(arg, body) )
+# 20591 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 815 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 20582 "parsing/parser.ml"
+# 20600 "parsing/parser.ml"
in
-# 1551 "parsing/parser.mly"
+# 1571 "parsing/parser.mly"
( _1 )
-# 20588 "parsing/parser.ml"
+# 20606 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 20636 "parsing/parser.ml"
+# 20654 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1140 "parsing/parser.mly"
+# 1162 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
-# 20645 "parsing/parser.ml"
+# 20663 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 20693 "parsing/parser.ml"
+# 20711 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1142 "parsing/parser.mly"
+# 1164 "parsing/parser.mly"
( unclosed "struct" _loc__1_ "end" _loc__4_ )
-# 20701 "parsing/parser.ml"
+# 20719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let me : (Parsetree.module_expr) = Obj.magic me in
let _4 : unit = Obj.magic _4 in
- let _1_inlined2 : ((string Asttypes.loc * Parsetree.module_type option) list) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.module_expr) = let args =
let _1 = _1_inlined2 in
-# 1106 "parsing/parser.mly"
+# 1128 "parsing/parser.mly"
( _1 )
-# 20756 "parsing/parser.ml"
+# 20774 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 20764 "parsing/parser.ml"
+# 20782 "parsing/parser.ml"
in
let _endpos = _endpos_me_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1144 "parsing/parser.mly"
+# 1166 "parsing/parser.mly"
( wrap_mod_attrs ~loc:_sloc attrs (
- List.fold_left (fun acc (x, mty) ->
- mkmod ~loc:_sloc (Pmod_functor (x, mty, acc))
+ List.fold_left (fun acc arg ->
+ mkmod ~loc:_sloc (Pmod_functor (arg, acc))
) me args
) )
-# 20777 "parsing/parser.ml"
+# 20795 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1150 "parsing/parser.mly"
+# 1172 "parsing/parser.mly"
( me )
-# 20802 "parsing/parser.ml"
+# 20820 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_attr_ in
let _v : (Parsetree.module_expr) =
-# 1152 "parsing/parser.mly"
+# 1174 "parsing/parser.mly"
( Mod.attr me attr )
-# 20834 "parsing/parser.ml"
+# 20852 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20865 "parsing/parser.ml"
+# 20883 "parsing/parser.ml"
in
-# 1156 "parsing/parser.mly"
+# 1178 "parsing/parser.mly"
( Pmod_ident x )
-# 20871 "parsing/parser.ml"
+# 20889 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 20880 "parsing/parser.ml"
+# 20898 "parsing/parser.ml"
in
-# 1168 "parsing/parser.mly"
+# 1190 "parsing/parser.mly"
( _1 )
-# 20886 "parsing/parser.ml"
+# 20904 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me2_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1159 "parsing/parser.mly"
+# 1181 "parsing/parser.mly"
( Pmod_apply(me1, me2) )
-# 20919 "parsing/parser.ml"
+# 20937 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 20928 "parsing/parser.ml"
+# 20946 "parsing/parser.ml"
in
-# 1168 "parsing/parser.mly"
+# 1190 "parsing/parser.mly"
( _1 )
-# 20934 "parsing/parser.ml"
+# 20952 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_me1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1162 "parsing/parser.mly"
+# 1184 "parsing/parser.mly"
( (* TODO review mkmod location *)
Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) )
-# 20979 "parsing/parser.ml"
+# 20997 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 20989 "parsing/parser.ml"
+# 21007 "parsing/parser.ml"
in
-# 1168 "parsing/parser.mly"
+# 1190 "parsing/parser.mly"
( _1 )
-# 20995 "parsing/parser.ml"
+# 21013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_ex_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1166 "parsing/parser.mly"
+# 1188 "parsing/parser.mly"
( Pmod_extension ex )
-# 21021 "parsing/parser.ml"
+# 21039 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21030 "parsing/parser.ml"
+# 21048 "parsing/parser.ml"
in
-# 1168 "parsing/parser.mly"
+# 1190 "parsing/parser.mly"
( _1 )
-# 21036 "parsing/parser.ml"
+# 21054 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = x;
+ MenhirLib.EngineTypes.startp = _startpos_x_;
+ MenhirLib.EngineTypes.endp = _endpos_x_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let x : (
+# 688 "parsing/parser.mly"
+ (string)
+# 21075 "parsing/parser.ml"
+ ) = Obj.magic x in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos_x_ in
+ let _endpos = _endpos_x_ in
+ let _v : (string option) =
+# 1145 "parsing/parser.mly"
+ ( Some x )
+# 21083 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (string option) =
+# 1148 "parsing/parser.mly"
+ ( None )
+# 21108 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 21096 "parsing/parser.ml"
+# 21168 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 21109 "parsing/parser.ml"
+# 21181 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21121 "parsing/parser.ml"
+# 21193 "parsing/parser.ml"
in
let uid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21132 "parsing/parser.ml"
+# 21204 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21140 "parsing/parser.ml"
+# 21212 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1581 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Ms.mk uid body ~attrs ~loc ~docs, ext
)
-# 21154 "parsing/parser.ml"
+# 21226 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 21207 "parsing/parser.ml"
+# 21279 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _2 : (string Asttypes.loc option) = Obj.magic _2 in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21223 "parsing/parser.ml"
+# 21295 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21231 "parsing/parser.ml"
+# 21303 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
-# 1588 "parsing/parser.mly"
+# 1608 "parsing/parser.mly"
( expecting _loc__6_ "module path" )
-# 21238 "parsing/parser.ml"
+# 21310 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21286 "parsing/parser.ml"
+# 21358 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1433 "parsing/parser.mly"
+# 1454 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
-# 21295 "parsing/parser.ml"
+# 21367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21343 "parsing/parser.ml"
+# 21415 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1435 "parsing/parser.mly"
+# 1456 "parsing/parser.mly"
( unclosed "sig" _loc__1_ "end" _loc__4_ )
-# 21351 "parsing/parser.ml"
+# 21423 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let mty : (Parsetree.module_type) = Obj.magic mty in
let _4 : unit = Obj.magic _4 in
- let _1_inlined2 : ((string Asttypes.loc * Parsetree.module_type option) list) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.module_type) = let args =
let _1 = _1_inlined2 in
-# 1106 "parsing/parser.mly"
+# 1128 "parsing/parser.mly"
( _1 )
-# 21406 "parsing/parser.ml"
+# 21478 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21414 "parsing/parser.ml"
+# 21486 "parsing/parser.ml"
in
let _endpos = _endpos_mty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1439 "parsing/parser.mly"
+# 1460 "parsing/parser.mly"
( wrap_mty_attrs ~loc:_sloc attrs (
- List.fold_left (fun acc (x, mty) ->
- mkmty ~loc:_sloc (Pmty_functor (x, mty, acc))
+ List.fold_left (fun acc arg ->
+ mkmty ~loc:_sloc (Pmty_functor (arg, acc))
) mty args
) )
-# 21427 "parsing/parser.ml"
+# 21499 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _4 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21482 "parsing/parser.ml"
+# 21554 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1445 "parsing/parser.mly"
+# 1466 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
-# 21491 "parsing/parser.ml"
+# 21563 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) =
-# 1447 "parsing/parser.mly"
+# 1468 "parsing/parser.mly"
( _2 )
-# 21530 "parsing/parser.ml"
+# 21602 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1449 "parsing/parser.mly"
+# 1470 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 21571 "parsing/parser.ml"
+# 21643 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_type) =
-# 1451 "parsing/parser.mly"
+# 1472 "parsing/parser.mly"
( Mty.attr _1 _2 )
-# 21603 "parsing/parser.ml"
+# 21675 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21634 "parsing/parser.ml"
+# 21706 "parsing/parser.ml"
in
-# 1454 "parsing/parser.mly"
+# 1475 "parsing/parser.mly"
( Pmty_ident _1 )
-# 21640 "parsing/parser.ml"
+# 21712 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 815 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21649 "parsing/parser.ml"
+# 21721 "parsing/parser.ml"
in
-# 1465 "parsing/parser.mly"
+# 1486 "parsing/parser.mly"
( _1 )
-# 21655 "parsing/parser.ml"
+# 21727 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1457 "parsing/parser.mly"
- ( Pmty_functor(mknoloc "_", Some _1, _3) )
-# 21695 "parsing/parser.ml"
+# 1478 "parsing/parser.mly"
+ ( Pmty_functor(Named (mknoloc None, _1), _3) )
+# 21767 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 815 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21704 "parsing/parser.ml"
+# 21776 "parsing/parser.ml"
in
-# 1465 "parsing/parser.mly"
+# 1486 "parsing/parser.mly"
( _1 )
-# 21710 "parsing/parser.ml"
+# 21782 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 21752 "parsing/parser.ml"
+# 21824 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 21757 "parsing/parser.ml"
+# 21829 "parsing/parser.ml"
in
-# 1459 "parsing/parser.mly"
+# 1480 "parsing/parser.mly"
( Pmty_with(_1, _3) )
-# 21763 "parsing/parser.ml"
+# 21835 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 815 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21773 "parsing/parser.ml"
+# 21845 "parsing/parser.ml"
in
-# 1465 "parsing/parser.mly"
+# 1486 "parsing/parser.mly"
( _1 )
-# 21779 "parsing/parser.ml"
+# 21851 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1463 "parsing/parser.mly"
+# 1484 "parsing/parser.mly"
( Pmty_extension _1 )
-# 21805 "parsing/parser.ml"
+# 21877 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 815 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21813 "parsing/parser.ml"
+# 21885 "parsing/parser.ml"
in
-# 1465 "parsing/parser.mly"
+# 1486 "parsing/parser.mly"
( _1 )
-# 21819 "parsing/parser.ml"
+# 21891 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 21888 "parsing/parser.ml"
+# 21960 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21900 "parsing/parser.ml"
+# 21972 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 21908 "parsing/parser.ml"
+# 21980 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1379 "parsing/parser.mly"
+# 1400 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Mtd.mk id ?typ ~attrs ~loc ~docs, ext
)
-# 21922 "parsing/parser.ml"
+# 21994 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3431 "parsing/parser.mly"
+# 3458 "parsing/parser.mly"
( Lident _1 )
-# 21947 "parsing/parser.ml"
+# 22019 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3432 "parsing/parser.mly"
+# 3459 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 21986 "parsing/parser.ml"
+# 22058 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag) =
-# 3501 "parsing/parser.mly"
+# 3528 "parsing/parser.mly"
( Immutable )
-# 22004 "parsing/parser.ml"
+# 22076 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3502 "parsing/parser.mly"
+# 3529 "parsing/parser.mly"
( Mutable )
-# 22029 "parsing/parser.ml"
+# 22101 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3510 "parsing/parser.mly"
+# 3537 "parsing/parser.mly"
( Immutable, Concrete )
-# 22047 "parsing/parser.ml"
+# 22119 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3512 "parsing/parser.mly"
+# 3539 "parsing/parser.mly"
( Mutable, Concrete )
-# 22072 "parsing/parser.ml"
+# 22144 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3514 "parsing/parser.mly"
+# 3541 "parsing/parser.mly"
( Immutable, Virtual )
-# 22097 "parsing/parser.ml"
+# 22169 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3517 "parsing/parser.mly"
+# 3544 "parsing/parser.mly"
( Mutable, Virtual )
-# 22129 "parsing/parser.ml"
+# 22201 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3517 "parsing/parser.mly"
+# 3544 "parsing/parser.mly"
( Mutable, Virtual )
-# 22161 "parsing/parser.ml"
+# 22233 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3474 "parsing/parser.mly"
+# 3501 "parsing/parser.mly"
( _2 )
-# 22193 "parsing/parser.ml"
+# 22265 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 22214 "parsing/parser.ml"
+# 22286 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22226 "parsing/parser.ml"
+# 22298 "parsing/parser.ml"
in
# 221 "menhir/standard.mly"
( [ x ] )
-# 22232 "parsing/parser.ml"
+# 22304 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let xs : (string Asttypes.loc list) = Obj.magic xs in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 22260 "parsing/parser.ml"
+# 22332 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22272 "parsing/parser.ml"
+# 22344 "parsing/parser.ml"
in
# 223 "menhir/standard.mly"
( x :: xs )
-# 22278 "parsing/parser.ml"
+# 22350 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let s : (
-# 658 "parsing/parser.mly"
+# 680 "parsing/parser.mly"
(string * string option)
-# 22299 "parsing/parser.ml"
+# 22371 "parsing/parser.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_s_ in
let _endpos = _endpos_s_ in
let _v : (string list) = let x =
-# 3470 "parsing/parser.mly"
+# 3497 "parsing/parser.mly"
( fst s )
-# 22307 "parsing/parser.ml"
+# 22379 "parsing/parser.ml"
in
# 221 "menhir/standard.mly"
( [ x ] )
-# 22312 "parsing/parser.ml"
+# 22384 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let xs : (string list) = Obj.magic xs in
let s : (
-# 658 "parsing/parser.mly"
+# 680 "parsing/parser.mly"
(string * string option)
-# 22340 "parsing/parser.ml"
+# 22412 "parsing/parser.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_s_ in
let _endpos = _endpos_xs_ in
let _v : (string list) = let x =
-# 3470 "parsing/parser.mly"
+# 3497 "parsing/parser.mly"
( fst s )
-# 22348 "parsing/parser.ml"
+# 22420 "parsing/parser.ml"
in
# 223 "menhir/standard.mly"
( x :: xs )
-# 22353 "parsing/parser.ml"
+# 22425 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 22378 "parsing/parser.ml"
+# 22450 "parsing/parser.ml"
in
-# 2823 "parsing/parser.mly"
+# 2846 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 22383 "parsing/parser.ml"
+# 22455 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 22415 "parsing/parser.ml"
+# 22487 "parsing/parser.ml"
in
-# 2823 "parsing/parser.mly"
+# 2846 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 22420 "parsing/parser.ml"
+# 22492 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_cs_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 22445 "parsing/parser.ml"
+# 22517 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "menhir/standard.mly"
( None )
-# 22451 "parsing/parser.ml"
+# 22523 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22456 "parsing/parser.ml"
+# 22528 "parsing/parser.ml"
in
-# 2827 "parsing/parser.mly"
+# 2850 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 22462 "parsing/parser.ml"
+# 22534 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 22494 "parsing/parser.ml"
+# 22566 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "menhir/standard.mly"
( None )
-# 22500 "parsing/parser.ml"
+# 22572 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22505 "parsing/parser.ml"
+# 22577 "parsing/parser.ml"
in
-# 2827 "parsing/parser.mly"
+# 2850 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 22511 "parsing/parser.ml"
+# 22583 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 22550 "parsing/parser.ml"
+# 22622 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "menhir/standard.mly"
( x )
-# 22557 "parsing/parser.ml"
+# 22629 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 22562 "parsing/parser.ml"
+# 22634 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22568 "parsing/parser.ml"
+# 22640 "parsing/parser.ml"
in
-# 2827 "parsing/parser.mly"
+# 2850 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 22574 "parsing/parser.ml"
+# 22646 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 22620 "parsing/parser.ml"
+# 22692 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "menhir/standard.mly"
( x )
-# 22627 "parsing/parser.ml"
+# 22699 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 22632 "parsing/parser.ml"
+# 22704 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22638 "parsing/parser.ml"
+# 22710 "parsing/parser.ml"
in
-# 2827 "parsing/parser.mly"
+# 2850 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 22644 "parsing/parser.ml"
+# 22716 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__3_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 22669 "parsing/parser.ml"
+# 22741 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "menhir/standard.mly"
( None )
-# 22675 "parsing/parser.ml"
+# 22747 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22680 "parsing/parser.ml"
+# 22752 "parsing/parser.ml"
in
-# 2831 "parsing/parser.mly"
+# 2854 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 22686 "parsing/parser.ml"
+# 22758 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 22718 "parsing/parser.ml"
+# 22790 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "menhir/standard.mly"
( None )
-# 22724 "parsing/parser.ml"
+# 22796 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22729 "parsing/parser.ml"
+# 22801 "parsing/parser.ml"
in
-# 2831 "parsing/parser.mly"
+# 2854 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 22735 "parsing/parser.ml"
+# 22807 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 22774 "parsing/parser.ml"
+# 22846 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "menhir/standard.mly"
( x )
-# 22781 "parsing/parser.ml"
+# 22853 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 22786 "parsing/parser.ml"
+# 22858 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22792 "parsing/parser.ml"
+# 22864 "parsing/parser.ml"
in
-# 2831 "parsing/parser.mly"
+# 2854 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 22798 "parsing/parser.ml"
+# 22870 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 22844 "parsing/parser.ml"
+# 22916 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "menhir/standard.mly"
( x )
-# 22851 "parsing/parser.ml"
+# 22923 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 22856 "parsing/parser.ml"
+# 22928 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22862 "parsing/parser.ml"
+# 22934 "parsing/parser.ml"
in
-# 2831 "parsing/parser.mly"
+# 2854 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 22868 "parsing/parser.ml"
+# 22940 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__3_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 22907 "parsing/parser.ml"
+# 22979 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "menhir/standard.mly"
( None )
-# 22913 "parsing/parser.ml"
+# 22985 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22918 "parsing/parser.ml"
+# 22990 "parsing/parser.ml"
in
-# 2835 "parsing/parser.mly"
+# 2858 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 22924 "parsing/parser.ml"
+# 22996 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 22970 "parsing/parser.ml"
+# 23042 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "menhir/standard.mly"
( None )
-# 22976 "parsing/parser.ml"
+# 23048 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 22981 "parsing/parser.ml"
+# 23053 "parsing/parser.ml"
in
-# 2835 "parsing/parser.mly"
+# 2858 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 22987 "parsing/parser.ml"
+# 23059 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 23040 "parsing/parser.ml"
+# 23112 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "menhir/standard.mly"
( x )
-# 23047 "parsing/parser.ml"
+# 23119 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 23052 "parsing/parser.ml"
+# 23124 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 23058 "parsing/parser.ml"
+# 23130 "parsing/parser.ml"
in
-# 2835 "parsing/parser.mly"
+# 2858 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23064 "parsing/parser.ml"
+# 23136 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 23124 "parsing/parser.ml"
+# 23196 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "menhir/standard.mly"
( x )
-# 23131 "parsing/parser.ml"
+# 23203 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 23136 "parsing/parser.ml"
+# 23208 "parsing/parser.ml"
in
-# 2839 "parsing/parser.mly"
+# 2862 "parsing/parser.mly"
( _1 )
-# 23142 "parsing/parser.ml"
+# 23214 "parsing/parser.ml"
in
-# 2835 "parsing/parser.mly"
+# 2858 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23148 "parsing/parser.ml"
+# 23220 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 23203 "parsing/parser.ml"
+# 23275 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 23212 "parsing/parser.ml"
+# 23284 "parsing/parser.ml"
in
let override =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 23218 "parsing/parser.ml"
+# 23290 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1398 "parsing/parser.mly"
+# 1419 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk me ~override ~attrs ~loc ~docs, ext
)
-# 23231 "parsing/parser.ml"
+# 23303 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 23293 "parsing/parser.ml"
+# 23365 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 23302 "parsing/parser.ml"
+# 23374 "parsing/parser.ml"
in
let override =
let _1 = _1_inlined1 in
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 23310 "parsing/parser.ml"
+# 23382 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1398 "parsing/parser.mly"
+# 1419 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk me ~override ~attrs ~loc ~docs, ext
)
-# 23324 "parsing/parser.ml"
+# 23396 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 23379 "parsing/parser.ml"
+# 23451 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 23391 "parsing/parser.ml"
+# 23463 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 23399 "parsing/parser.ml"
+# 23471 "parsing/parser.ml"
in
let override =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 23405 "parsing/parser.ml"
+# 23477 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1413 "parsing/parser.mly"
+# 1434 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk id ~override ~attrs ~loc ~docs, ext
)
-# 23418 "parsing/parser.ml"
+# 23490 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 23480 "parsing/parser.ml"
+# 23552 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 23492 "parsing/parser.ml"
+# 23564 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined2 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 23500 "parsing/parser.ml"
+# 23572 "parsing/parser.ml"
in
let override =
let _1 = _1_inlined1 in
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 23508 "parsing/parser.ml"
+# 23580 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1413 "parsing/parser.mly"
+# 1434 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk id ~override ~attrs ~loc ~docs, ext
)
-# 23522 "parsing/parser.ml"
+# 23594 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 644 "parsing/parser.mly"
+# 666 "parsing/parser.mly"
(string)
-# 23543 "parsing/parser.ml"
+# 23615 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3353 "parsing/parser.mly"
+# 3376 "parsing/parser.mly"
( _1 )
-# 23551 "parsing/parser.ml"
+# 23623 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 602 "parsing/parser.mly"
+# 624 "parsing/parser.mly"
(string)
-# 23572 "parsing/parser.ml"
+# 23644 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3354 "parsing/parser.mly"
+# 3377 "parsing/parser.mly"
( _1 )
-# 23580 "parsing/parser.ml"
+# 23652 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 603 "parsing/parser.mly"
+# 625 "parsing/parser.mly"
(string)
-# 23601 "parsing/parser.ml"
+# 23673 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3355 "parsing/parser.mly"
+# 3378 "parsing/parser.mly"
( _1 )
-# 23609 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- } = _menhir_stack in
- let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (
-# 601 "parsing/parser.mly"
- (string)
-# 23644 "parsing/parser.ml"
- ) = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__3_ in
- let _v : (string) =
-# 3356 "parsing/parser.mly"
- ( "."^ _1 ^"()" )
-# 23652 "parsing/parser.ml"
+# 23681 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _4 : unit = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
+ let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 23694 "parsing/parser.ml"
+# 23723 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (string) =
-# 3357 "parsing/parser.mly"
- ( "."^ _1 ^ "()<-" )
-# 23702 "parsing/parser.ml"
+# 3379 "parsing/parser.mly"
+ ( "."^ _1 ^"(" ^ _3 ^ ")" )
+# 23731 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
} = _menhir_stack in
- let _3 : unit = Obj.magic _3 in
+ let _5 : unit = Obj.magic _5 in
+ let _4 : unit = Obj.magic _4 in
+ let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 23737 "parsing/parser.ml"
+# 23780 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__3_ in
+ let _endpos = _endpos__5_ in
let _v : (string) =
-# 3358 "parsing/parser.mly"
- ( "."^ _1 ^"[]" )
-# 23745 "parsing/parser.ml"
+# 3380 "parsing/parser.mly"
+ ( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
+# 23788 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _4 : unit = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
+ let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 23787 "parsing/parser.ml"
+# 23830 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (string) =
-# 3359 "parsing/parser.mly"
- ( "."^ _1 ^ "[]<-" )
-# 23795 "parsing/parser.ml"
+# 3381 "parsing/parser.mly"
+ ( "."^ _1 ^"[" ^ _3 ^ "]" )
+# 23838 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
} = _menhir_stack in
- let _3 : unit = Obj.magic _3 in
+ let _5 : unit = Obj.magic _5 in
+ let _4 : unit = Obj.magic _4 in
+ let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 23830 "parsing/parser.ml"
+# 23887 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__3_ in
+ let _endpos = _endpos__5_ in
let _v : (string) =
-# 3360 "parsing/parser.mly"
- ( "."^ _1 ^"{}" )
-# 23838 "parsing/parser.ml"
+# 3382 "parsing/parser.mly"
+ ( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
+# 23895 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _4 : unit = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
+ let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 23880 "parsing/parser.ml"
+# 23937 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (string) =
-# 3361 "parsing/parser.mly"
- ( "."^ _1 ^ "{}<-" )
-# 23888 "parsing/parser.ml"
+# 3383 "parsing/parser.mly"
+ ( "."^ _1 ^"{" ^ _3 ^ "}" )
+# 23945 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _5 : unit = Obj.magic _5 in
+ let _4 : unit = Obj.magic _4 in
+ let _3 : (string) = Obj.magic _3 in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : (
+# 623 "parsing/parser.mly"
+ (string)
+# 23994 "parsing/parser.ml"
+ ) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__5_ in
+ let _v : (string) =
+# 3384 "parsing/parser.mly"
+ ( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
+# 24002 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 655 "parsing/parser.mly"
+# 677 "parsing/parser.mly"
(string)
-# 23909 "parsing/parser.ml"
+# 24023 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3362 "parsing/parser.mly"
+# 3385 "parsing/parser.mly"
( _1 )
-# 23917 "parsing/parser.ml"
+# 24031 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3363 "parsing/parser.mly"
+# 3386 "parsing/parser.mly"
( "!" )
-# 23942 "parsing/parser.ml"
+# 24056 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 596 "parsing/parser.mly"
+# 618 "parsing/parser.mly"
(string)
-# 23963 "parsing/parser.ml"
+# 24077 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3367 "parsing/parser.mly"
+# 3390 "parsing/parser.mly"
( op )
-# 23971 "parsing/parser.ml"
+# 24085 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 23976 "parsing/parser.ml"
+# 24090 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 597 "parsing/parser.mly"
+# 619 "parsing/parser.mly"
(string)
-# 23997 "parsing/parser.ml"
+# 24111 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3368 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
( op )
-# 24005 "parsing/parser.ml"
+# 24119 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24010 "parsing/parser.ml"
+# 24124 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 598 "parsing/parser.mly"
+# 620 "parsing/parser.mly"
(string)
-# 24031 "parsing/parser.ml"
+# 24145 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3369 "parsing/parser.mly"
+# 3392 "parsing/parser.mly"
( op )
-# 24039 "parsing/parser.ml"
+# 24153 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24044 "parsing/parser.ml"
+# 24158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 599 "parsing/parser.mly"
+# 621 "parsing/parser.mly"
(string)
-# 24065 "parsing/parser.ml"
+# 24179 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3370 "parsing/parser.mly"
+# 3393 "parsing/parser.mly"
( op )
-# 24073 "parsing/parser.ml"
+# 24187 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24078 "parsing/parser.ml"
+# 24192 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 600 "parsing/parser.mly"
+# 622 "parsing/parser.mly"
(string)
-# 24099 "parsing/parser.ml"
+# 24213 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (string) = let _1 =
-# 3371 "parsing/parser.mly"
+# 3394 "parsing/parser.mly"
( op )
-# 24107 "parsing/parser.ml"
+# 24221 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24112 "parsing/parser.ml"
+# 24226 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3372 "parsing/parser.mly"
+# 3395 "parsing/parser.mly"
("+")
-# 24137 "parsing/parser.ml"
+# 24251 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24142 "parsing/parser.ml"
+# 24256 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3373 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
("+.")
-# 24167 "parsing/parser.ml"
+# 24281 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24172 "parsing/parser.ml"
+# 24286 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3374 "parsing/parser.mly"
+# 3397 "parsing/parser.mly"
("+=")
-# 24197 "parsing/parser.ml"
+# 24311 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24202 "parsing/parser.ml"
+# 24316 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3375 "parsing/parser.mly"
+# 3398 "parsing/parser.mly"
("-")
-# 24227 "parsing/parser.ml"
+# 24341 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24232 "parsing/parser.ml"
+# 24346 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3376 "parsing/parser.mly"
+# 3399 "parsing/parser.mly"
("-.")
-# 24257 "parsing/parser.ml"
+# 24371 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24262 "parsing/parser.ml"
+# 24376 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3377 "parsing/parser.mly"
+# 3400 "parsing/parser.mly"
("*")
-# 24287 "parsing/parser.ml"
+# 24401 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24292 "parsing/parser.ml"
+# 24406 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3378 "parsing/parser.mly"
+# 3401 "parsing/parser.mly"
("%")
-# 24317 "parsing/parser.ml"
+# 24431 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24322 "parsing/parser.ml"
+# 24436 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3379 "parsing/parser.mly"
+# 3402 "parsing/parser.mly"
("=")
-# 24347 "parsing/parser.ml"
+# 24461 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24352 "parsing/parser.ml"
+# 24466 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3380 "parsing/parser.mly"
+# 3403 "parsing/parser.mly"
("<")
-# 24377 "parsing/parser.ml"
+# 24491 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24382 "parsing/parser.ml"
+# 24496 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3381 "parsing/parser.mly"
+# 3404 "parsing/parser.mly"
(">")
-# 24407 "parsing/parser.ml"
+# 24521 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24412 "parsing/parser.ml"
+# 24526 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3382 "parsing/parser.mly"
+# 3405 "parsing/parser.mly"
("or")
-# 24437 "parsing/parser.ml"
+# 24551 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24442 "parsing/parser.ml"
+# 24556 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3383 "parsing/parser.mly"
+# 3406 "parsing/parser.mly"
("||")
-# 24467 "parsing/parser.ml"
+# 24581 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24472 "parsing/parser.ml"
+# 24586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3384 "parsing/parser.mly"
+# 3407 "parsing/parser.mly"
("&")
-# 24497 "parsing/parser.ml"
+# 24611 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24502 "parsing/parser.ml"
+# 24616 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3385 "parsing/parser.mly"
+# 3408 "parsing/parser.mly"
("&&")
-# 24527 "parsing/parser.ml"
+# 24641 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24532 "parsing/parser.ml"
+# 24646 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) = let _1 =
-# 3386 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
(":=")
-# 24557 "parsing/parser.ml"
+# 24671 "parsing/parser.ml"
in
-# 3364 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( _1 )
-# 24562 "parsing/parser.ml"
+# 24676 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (bool) =
-# 3271 "parsing/parser.mly"
+# 3294 "parsing/parser.mly"
( true )
-# 24587 "parsing/parser.ml"
+# 24701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (bool) =
-# 3272 "parsing/parser.mly"
+# 3295 "parsing/parser.mly"
( false )
-# 24605 "parsing/parser.ml"
+# 24719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "menhir/standard.mly"
( None )
-# 24623 "parsing/parser.ml"
+# 24737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "menhir/standard.mly"
( Some x )
-# 24648 "parsing/parser.ml"
+# 24762 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "menhir/standard.mly"
( None )
-# 24666 "parsing/parser.ml"
+# 24780 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "menhir/standard.mly"
( Some x )
-# 24691 "parsing/parser.ml"
+# 24805 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (string Asttypes.loc option) =
# 114 "menhir/standard.mly"
( None )
-# 24709 "parsing/parser.ml"
+# 24823 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 24736 "parsing/parser.ml"
+# 24850 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 24751 "parsing/parser.ml"
+# 24865 "parsing/parser.ml"
in
# 183 "menhir/standard.mly"
( x )
-# 24757 "parsing/parser.ml"
+# 24871 "parsing/parser.ml"
in
# 116 "menhir/standard.mly"
( Some x )
-# 24763 "parsing/parser.ml"
+# 24877 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) =
# 114 "menhir/standard.mly"
( None )
-# 24781 "parsing/parser.ml"
+# 24895 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) = let x =
# 183 "menhir/standard.mly"
( x )
-# 24813 "parsing/parser.ml"
+# 24927 "parsing/parser.ml"
in
# 116 "menhir/standard.mly"
( Some x )
-# 24818 "parsing/parser.ml"
+# 24932 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "menhir/standard.mly"
( None )
-# 24836 "parsing/parser.ml"
+# 24950 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "menhir/standard.mly"
( x )
-# 24868 "parsing/parser.ml"
+# 24982 "parsing/parser.ml"
in
# 116 "menhir/standard.mly"
( Some x )
-# 24873 "parsing/parser.ml"
+# 24987 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) =
# 114 "menhir/standard.mly"
( None )
-# 24891 "parsing/parser.ml"
+# 25005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) = let x =
# 183 "menhir/standard.mly"
( x )
-# 24923 "parsing/parser.ml"
+# 25037 "parsing/parser.ml"
in
# 116 "menhir/standard.mly"
( Some x )
-# 24928 "parsing/parser.ml"
+# 25042 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) =
# 114 "menhir/standard.mly"
( None )
-# 24946 "parsing/parser.ml"
+# 25060 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) = let x =
# 183 "menhir/standard.mly"
( x )
-# 24978 "parsing/parser.ml"
+# 25092 "parsing/parser.ml"
in
# 116 "menhir/standard.mly"
( Some x )
-# 24983 "parsing/parser.ml"
+# 25097 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "menhir/standard.mly"
( None )
-# 25001 "parsing/parser.ml"
+# 25115 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "menhir/standard.mly"
( x )
-# 25033 "parsing/parser.ml"
+# 25147 "parsing/parser.ml"
in
# 116 "menhir/standard.mly"
( Some x )
-# 25038 "parsing/parser.ml"
+# 25152 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 114 "menhir/standard.mly"
( None )
-# 25056 "parsing/parser.ml"
+# 25170 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 116 "menhir/standard.mly"
( Some x )
-# 25081 "parsing/parser.ml"
+# 25195 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 637 "parsing/parser.mly"
+# 659 "parsing/parser.mly"
(string)
-# 25102 "parsing/parser.ml"
+# 25216 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3556 "parsing/parser.mly"
+# 3583 "parsing/parser.mly"
( _1 )
-# 25110 "parsing/parser.ml"
+# 25224 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 25144 "parsing/parser.ml"
+# 25258 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) =
-# 3557 "parsing/parser.mly"
+# 3584 "parsing/parser.mly"
( _2 )
-# 25153 "parsing/parser.ml"
+# 25267 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1177 "parsing/parser.mly"
+# 1199 "parsing/parser.mly"
( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
-# 25209 "parsing/parser.ml"
+# 25323 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1179 "parsing/parser.mly"
+# 1201 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 25264 "parsing/parser.ml"
+# 25378 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_expr) =
-# 1182 "parsing/parser.mly"
+# 1204 "parsing/parser.mly"
( me (* TODO consider reloc *) )
-# 25303 "parsing/parser.ml"
+# 25417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1184 "parsing/parser.mly"
+# 1206 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 25344 "parsing/parser.ml"
+# 25458 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.module_expr) = let e =
-# 1201 "parsing/parser.mly"
+# 1223 "parsing/parser.mly"
( e )
-# 25397 "parsing/parser.ml"
+# 25511 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25404 "parsing/parser.ml"
+# 25518 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1188 "parsing/parser.mly"
+# 1210 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 25413 "parsing/parser.ml"
+# 25527 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty =
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 25484 "parsing/parser.ml"
+# 25598 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 25492 "parsing/parser.ml"
+# 25606 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 25498 "parsing/parser.ml"
+# 25612 "parsing/parser.ml"
in
let _endpos_ty_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1203 "parsing/parser.mly"
+# 1225 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 25508 "parsing/parser.ml"
+# 25622 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25516 "parsing/parser.ml"
+# 25630 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1188 "parsing/parser.mly"
+# 1210 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 25525 "parsing/parser.ml"
+# 25639 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 25611 "parsing/parser.ml"
+# 25725 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 25619 "parsing/parser.ml"
+# 25733 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 25625 "parsing/parser.ml"
+# 25739 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_inlined1_ in
let ty1 =
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 25634 "parsing/parser.ml"
+# 25748 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 25642 "parsing/parser.ml"
+# 25756 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 25648 "parsing/parser.ml"
+# 25762 "parsing/parser.ml"
in
let _endpos = _endpos_ty2_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1205 "parsing/parser.mly"
+# 1227 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 25657 "parsing/parser.ml"
+# 25771 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25665 "parsing/parser.ml"
+# 25779 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1188 "parsing/parser.mly"
+# 1210 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 25674 "parsing/parser.ml"
+# 25788 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty2 =
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 25745 "parsing/parser.ml"
+# 25859 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 25753 "parsing/parser.ml"
+# 25867 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 25759 "parsing/parser.ml"
+# 25873 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1207 "parsing/parser.mly"
+# 1229 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 25769 "parsing/parser.ml"
+# 25883 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25777 "parsing/parser.ml"
+# 25891 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1188 "parsing/parser.mly"
+# 1210 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 25786 "parsing/parser.ml"
+# 25900 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25848 "parsing/parser.ml"
+# 25962 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1190 "parsing/parser.mly"
+# 1212 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 25856 "parsing/parser.ml"
+# 25970 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25918 "parsing/parser.ml"
+# 26032 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1192 "parsing/parser.mly"
+# 1214 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 25926 "parsing/parser.ml"
+# 26040 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 25981 "parsing/parser.ml"
+# 26095 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1194 "parsing/parser.mly"
+# 1216 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 25989 "parsing/parser.ml"
+# 26103 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 754 "parsing/parser.mly"
+# 776 "parsing/parser.mly"
(Parsetree.core_type)
-# 26021 "parsing/parser.ml"
+# 26135 "parsing/parser.ml"
) =
-# 1087 "parsing/parser.mly"
+# 1109 "parsing/parser.mly"
( _1 )
-# 26025 "parsing/parser.ml"
+# 26139 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 756 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
(Parsetree.expression)
-# 26057 "parsing/parser.ml"
+# 26171 "parsing/parser.ml"
) =
-# 1092 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( _1 )
-# 26061 "parsing/parser.ml"
+# 26175 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 758 "parsing/parser.mly"
+# 780 "parsing/parser.mly"
(Parsetree.pattern)
-# 26093 "parsing/parser.ml"
+# 26207 "parsing/parser.ml"
) =
-# 1097 "parsing/parser.mly"
+# 1119 "parsing/parser.mly"
( _1 )
-# 26097 "parsing/parser.ml"
+# 26211 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2558 "parsing/parser.mly"
+# 2581 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 26141 "parsing/parser.ml"
+# 26255 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26147 "parsing/parser.ml"
+# 26261 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2560 "parsing/parser.mly"
+# 2583 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 26179 "parsing/parser.ml"
+# 26293 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26184 "parsing/parser.ml"
+# 26298 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2562 "parsing/parser.mly"
+# 2585 "parsing/parser.mly"
( _1 )
-# 26209 "parsing/parser.ml"
+# 26323 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26214 "parsing/parser.ml"
+# 26328 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 26261 "parsing/parser.ml"
+# 26375 "parsing/parser.ml"
in
-# 2565 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 26267 "parsing/parser.ml"
+# 26381 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26277 "parsing/parser.ml"
+# 26391 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 26283 "parsing/parser.ml"
+# 26397 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26289 "parsing/parser.ml"
+# 26403 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2567 "parsing/parser.mly"
+# 2590 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 26332 "parsing/parser.ml"
+# 26446 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26342 "parsing/parser.ml"
+# 26456 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 26348 "parsing/parser.ml"
+# 26462 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26354 "parsing/parser.ml"
+# 26468 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2569 "parsing/parser.mly"
+# 2592 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 26381 "parsing/parser.ml"
+# 26495 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26389 "parsing/parser.ml"
+# 26503 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 26395 "parsing/parser.ml"
+# 26509 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26401 "parsing/parser.ml"
+# 26515 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2571 "parsing/parser.mly"
+# 2594 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 26444 "parsing/parser.ml"
+# 26558 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26454 "parsing/parser.ml"
+# 26568 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 26460 "parsing/parser.ml"
+# 26574 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26466 "parsing/parser.ml"
+# 26580 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2573 "parsing/parser.mly"
+# 2596 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 26507 "parsing/parser.ml"
+# 26621 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26516 "parsing/parser.ml"
+# 26630 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 26522 "parsing/parser.ml"
+# 26636 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26528 "parsing/parser.ml"
+# 26642 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2575 "parsing/parser.mly"
+# 2598 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 26571 "parsing/parser.ml"
+# 26685 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26581 "parsing/parser.ml"
+# 26695 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 26587 "parsing/parser.ml"
+# 26701 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( _1 )
-# 26593 "parsing/parser.ml"
+# 26707 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 26643 "parsing/parser.ml"
+# 26757 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 26649 "parsing/parser.ml"
+# 26763 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2548 "parsing/parser.mly"
+# 2571 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
-# 26658 "parsing/parser.ml"
+# 26772 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2672 "parsing/parser.mly"
+# 2695 "parsing/parser.mly"
( _3 :: _1 )
-# 26697 "parsing/parser.ml"
+# 26811 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2673 "parsing/parser.mly"
+# 2696 "parsing/parser.mly"
( [_3; _1] )
-# 26736 "parsing/parser.ml"
+# 26850 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2674 "parsing/parser.mly"
+# 2697 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 26776 "parsing/parser.ml"
+# 26890 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2672 "parsing/parser.mly"
+# 2695 "parsing/parser.mly"
( _3 :: _1 )
-# 26815 "parsing/parser.ml"
+# 26929 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2673 "parsing/parser.mly"
+# 2696 "parsing/parser.mly"
( [_3; _1] )
-# 26854 "parsing/parser.ml"
+# 26968 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2674 "parsing/parser.mly"
+# 2697 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 26894 "parsing/parser.ml"
+# 27008 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2581 "parsing/parser.mly"
+# 2604 "parsing/parser.mly"
( _1 )
-# 26919 "parsing/parser.ml"
+# 27033 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 26957 "parsing/parser.ml"
+# 27071 "parsing/parser.ml"
in
-# 2584 "parsing/parser.mly"
+# 2607 "parsing/parser.mly"
( Ppat_construct(_1, Some _2) )
-# 26963 "parsing/parser.ml"
+# 27077 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 26973 "parsing/parser.ml"
+# 27087 "parsing/parser.ml"
in
-# 2587 "parsing/parser.mly"
+# 2610 "parsing/parser.mly"
( _1 )
-# 26979 "parsing/parser.ml"
+# 27093 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2586 "parsing/parser.mly"
+# 2609 "parsing/parser.mly"
( Ppat_variant(_1, Some _2) )
-# 27012 "parsing/parser.ml"
+# 27126 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27021 "parsing/parser.ml"
+# 27135 "parsing/parser.ml"
in
-# 2587 "parsing/parser.mly"
+# 2610 "parsing/parser.mly"
( _1 )
-# 27027 "parsing/parser.ml"
+# 27141 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 27077 "parsing/parser.ml"
+# 27191 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 27083 "parsing/parser.ml"
+# 27197 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2589 "parsing/parser.mly"
+# 2612 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
-# 27092 "parsing/parser.ml"
+# 27206 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2558 "parsing/parser.mly"
+# 2581 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 27136 "parsing/parser.ml"
+# 27250 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27142 "parsing/parser.ml"
+# 27256 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2560 "parsing/parser.mly"
+# 2583 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 27174 "parsing/parser.ml"
+# 27288 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27179 "parsing/parser.ml"
+# 27293 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2562 "parsing/parser.mly"
+# 2585 "parsing/parser.mly"
( _1 )
-# 27204 "parsing/parser.ml"
+# 27318 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27209 "parsing/parser.ml"
+# 27323 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27256 "parsing/parser.ml"
+# 27370 "parsing/parser.ml"
in
-# 2565 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 27262 "parsing/parser.ml"
+# 27376 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27272 "parsing/parser.ml"
+# 27386 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 27278 "parsing/parser.ml"
+# 27392 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27284 "parsing/parser.ml"
+# 27398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2567 "parsing/parser.mly"
+# 2590 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 27327 "parsing/parser.ml"
+# 27441 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27337 "parsing/parser.ml"
+# 27451 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 27343 "parsing/parser.ml"
+# 27457 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27349 "parsing/parser.ml"
+# 27463 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2569 "parsing/parser.mly"
+# 2592 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 27376 "parsing/parser.ml"
+# 27490 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27384 "parsing/parser.ml"
+# 27498 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 27390 "parsing/parser.ml"
+# 27504 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27396 "parsing/parser.ml"
+# 27510 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2571 "parsing/parser.mly"
+# 2594 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27439 "parsing/parser.ml"
+# 27553 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27449 "parsing/parser.ml"
+# 27563 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 27455 "parsing/parser.ml"
+# 27569 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27461 "parsing/parser.ml"
+# 27575 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2573 "parsing/parser.mly"
+# 2596 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 27502 "parsing/parser.ml"
+# 27616 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27511 "parsing/parser.ml"
+# 27625 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 27517 "parsing/parser.ml"
+# 27631 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27523 "parsing/parser.ml"
+# 27637 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2575 "parsing/parser.mly"
+# 2598 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27566 "parsing/parser.ml"
+# 27680 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27576 "parsing/parser.ml"
+# 27690 "parsing/parser.ml"
in
-# 2576 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( _1 )
-# 27582 "parsing/parser.ml"
+# 27696 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( _1 )
-# 27588 "parsing/parser.ml"
+# 27702 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 27609 "parsing/parser.ml"
+# 27723 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27623 "parsing/parser.ml"
+# 27737 "parsing/parser.ml"
in
-# 2034 "parsing/parser.mly"
+# 2054 "parsing/parser.mly"
( Ppat_var _1 )
-# 27629 "parsing/parser.ml"
+# 27743 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27638 "parsing/parser.ml"
+# 27752 "parsing/parser.ml"
in
-# 2036 "parsing/parser.mly"
+# 2056 "parsing/parser.mly"
( _1 )
-# 27644 "parsing/parser.ml"
+# 27758 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2035 "parsing/parser.mly"
+# 2055 "parsing/parser.mly"
( Ppat_any )
-# 27670 "parsing/parser.ml"
+# 27784 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27678 "parsing/parser.ml"
+# 27792 "parsing/parser.ml"
in
-# 2036 "parsing/parser.mly"
+# 2056 "parsing/parser.mly"
( _1 )
-# 27684 "parsing/parser.ml"
+# 27798 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.payload) =
-# 3662 "parsing/parser.mly"
+# 3689 "parsing/parser.mly"
( PStr _1 )
-# 27709 "parsing/parser.ml"
+# 27823 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3663 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( PSig _2 )
-# 27741 "parsing/parser.ml"
+# 27855 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3664 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( PTyp _2 )
-# 27773 "parsing/parser.ml"
+# 27887 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3665 "parsing/parser.mly"
+# 3692 "parsing/parser.mly"
( PPat (_2, None) )
-# 27805 "parsing/parser.ml"
+# 27919 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.payload) =
-# 3666 "parsing/parser.mly"
+# 3693 "parsing/parser.mly"
( PPat (_2, Some _4) )
-# 27851 "parsing/parser.ml"
+# 27965 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3085 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
( _1 )
-# 27876 "parsing/parser.ml"
+# 27990 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 27919 "parsing/parser.ml"
+# 28033 "parsing/parser.ml"
in
-# 872 "parsing/parser.mly"
+# 894 "parsing/parser.mly"
( xs )
-# 27924 "parsing/parser.ml"
+# 28038 "parsing/parser.ml"
in
-# 3077 "parsing/parser.mly"
+# 3100 "parsing/parser.mly"
( _1 )
-# 27930 "parsing/parser.ml"
+# 28044 "parsing/parser.ml"
in
-# 3081 "parsing/parser.mly"
+# 3104 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 27936 "parsing/parser.ml"
+# 28050 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 27946 "parsing/parser.ml"
+# 28060 "parsing/parser.ml"
in
-# 3087 "parsing/parser.mly"
+# 3110 "parsing/parser.mly"
( _1 )
-# 27952 "parsing/parser.ml"
+# 28066 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 27977 "parsing/parser.ml"
+# 28091 "parsing/parser.ml"
in
-# 3085 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
( _1 )
-# 27982 "parsing/parser.ml"
+# 28096 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let _3 =
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 28023 "parsing/parser.ml"
+# 28137 "parsing/parser.ml"
in
let _1 =
let _1 =
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 28030 "parsing/parser.ml"
+# 28144 "parsing/parser.ml"
in
-# 872 "parsing/parser.mly"
+# 894 "parsing/parser.mly"
( xs )
-# 28035 "parsing/parser.ml"
+# 28149 "parsing/parser.ml"
in
-# 3077 "parsing/parser.mly"
+# 3100 "parsing/parser.mly"
( _1 )
-# 28041 "parsing/parser.ml"
+# 28155 "parsing/parser.ml"
in
-# 3081 "parsing/parser.mly"
+# 3104 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 28047 "parsing/parser.ml"
+# 28161 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 28057 "parsing/parser.ml"
+# 28171 "parsing/parser.ml"
in
-# 3087 "parsing/parser.mly"
+# 3110 "parsing/parser.mly"
( _1 )
-# 28063 "parsing/parser.ml"
+# 28177 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3629 "parsing/parser.mly"
+# 3656 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 28112 "parsing/parser.ml"
+# 28226 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 28195 "parsing/parser.ml"
+# 28309 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28207 "parsing/parser.ml"
+# 28321 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 28215 "parsing/parser.ml"
+# 28329 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2733 "parsing/parser.mly"
+# 2756 "parsing/parser.mly"
( let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Val.mk id ty ~prim ~attrs ~loc ~docs,
ext )
-# 28228 "parsing/parser.ml"
+# 28342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag) = let _1 =
-# 3497 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( Public )
-# 28246 "parsing/parser.ml"
+# 28360 "parsing/parser.ml"
in
-# 3494 "parsing/parser.mly"
+# 3521 "parsing/parser.mly"
( _1 )
-# 28251 "parsing/parser.ml"
+# 28365 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) = let _1 =
-# 3498 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( Private )
-# 28276 "parsing/parser.ml"
+# 28390 "parsing/parser.ml"
in
-# 3494 "parsing/parser.mly"
+# 3521 "parsing/parser.mly"
( _1 )
-# 28281 "parsing/parser.ml"
+# 28395 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3520 "parsing/parser.mly"
+# 3547 "parsing/parser.mly"
( Public, Concrete )
-# 28299 "parsing/parser.ml"
+# 28413 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3521 "parsing/parser.mly"
+# 3548 "parsing/parser.mly"
( Private, Concrete )
-# 28324 "parsing/parser.ml"
+# 28438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3522 "parsing/parser.mly"
+# 3549 "parsing/parser.mly"
( Public, Virtual )
-# 28349 "parsing/parser.ml"
+# 28463 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3523 "parsing/parser.mly"
+# 3550 "parsing/parser.mly"
( Private, Virtual )
-# 28381 "parsing/parser.ml"
+# 28495 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3524 "parsing/parser.mly"
+# 3551 "parsing/parser.mly"
( Private, Virtual )
-# 28413 "parsing/parser.ml"
+# 28527 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.rec_flag) =
-# 3477 "parsing/parser.mly"
+# 3504 "parsing/parser.mly"
( Nonrecursive )
-# 28431 "parsing/parser.ml"
+# 28545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.rec_flag) =
-# 3478 "parsing/parser.mly"
+# 3505 "parsing/parser.mly"
( Recursive )
-# 28456 "parsing/parser.ml"
+# 28570 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
(Longident.t Asttypes.loc * Parsetree.expression) list) = let eo =
# 124 "menhir/standard.mly"
( None )
-# 28482 "parsing/parser.ml"
+# 28596 "parsing/parser.ml"
in
-# 2478 "parsing/parser.mly"
+# 2501 "parsing/parser.mly"
( eo, fields )
-# 28487 "parsing/parser.ml"
+# 28601 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x =
# 191 "menhir/standard.mly"
( x )
-# 28528 "parsing/parser.ml"
+# 28642 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 28533 "parsing/parser.ml"
+# 28647 "parsing/parser.ml"
in
-# 2478 "parsing/parser.mly"
+# 2501 "parsing/parser.mly"
( eo, fields )
-# 28539 "parsing/parser.ml"
+# 28653 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2907 "parsing/parser.mly"
+# 2930 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 28569 "parsing/parser.ml"
+# 28683 "parsing/parser.ml"
in
-# 982 "parsing/parser.mly"
+# 1004 "parsing/parser.mly"
( [x] )
-# 28574 "parsing/parser.ml"
+# 28688 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2907 "parsing/parser.mly"
+# 2930 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 28604 "parsing/parser.ml"
+# 28718 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 1007 "parsing/parser.mly"
( [x] )
-# 28609 "parsing/parser.ml"
+# 28723 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2907 "parsing/parser.mly"
+# 2930 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 28646 "parsing/parser.ml"
+# 28760 "parsing/parser.ml"
in
-# 989 "parsing/parser.mly"
+# 1011 "parsing/parser.mly"
( x :: xs )
-# 28651 "parsing/parser.ml"
+# 28765 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3019 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 28682 "parsing/parser.ml"
+# 28796 "parsing/parser.ml"
in
-# 3013 "parsing/parser.mly"
+# 3036 "parsing/parser.mly"
( _1 )
-# 28687 "parsing/parser.ml"
+# 28801 "parsing/parser.ml"
in
-# 982 "parsing/parser.mly"
+# 1004 "parsing/parser.mly"
( [x] )
-# 28693 "parsing/parser.ml"
+# 28807 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3015 "parsing/parser.mly"
+# 3038 "parsing/parser.mly"
( _1 )
-# 28718 "parsing/parser.ml"
+# 28832 "parsing/parser.ml"
in
-# 982 "parsing/parser.mly"
+# 1004 "parsing/parser.mly"
( [x] )
-# 28723 "parsing/parser.ml"
+# 28837 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3019 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 28754 "parsing/parser.ml"
+# 28868 "parsing/parser.ml"
in
-# 3013 "parsing/parser.mly"
+# 3036 "parsing/parser.mly"
( _1 )
-# 28759 "parsing/parser.ml"
+# 28873 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 1007 "parsing/parser.mly"
( [x] )
-# 28765 "parsing/parser.ml"
+# 28879 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3015 "parsing/parser.mly"
+# 3038 "parsing/parser.mly"
( _1 )
-# 28790 "parsing/parser.ml"
+# 28904 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 1007 "parsing/parser.mly"
( [x] )
-# 28795 "parsing/parser.ml"
+# 28909 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3019 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 28833 "parsing/parser.ml"
+# 28947 "parsing/parser.ml"
in
-# 3013 "parsing/parser.mly"
+# 3036 "parsing/parser.mly"
( _1 )
-# 28838 "parsing/parser.ml"
+# 28952 "parsing/parser.ml"
in
-# 989 "parsing/parser.mly"
+# 1011 "parsing/parser.mly"
( x :: xs )
-# 28844 "parsing/parser.ml"
+# 28958 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3015 "parsing/parser.mly"
+# 3038 "parsing/parser.mly"
( _1 )
-# 28876 "parsing/parser.ml"
+# 28990 "parsing/parser.ml"
in
-# 989 "parsing/parser.mly"
+# 1011 "parsing/parser.mly"
( x :: xs )
-# 28881 "parsing/parser.ml"
+# 28995 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3019 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 28911 "parsing/parser.ml"
+# 29025 "parsing/parser.ml"
in
-# 982 "parsing/parser.mly"
+# 1004 "parsing/parser.mly"
( [x] )
-# 28916 "parsing/parser.ml"
+# 29030 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3019 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 28946 "parsing/parser.ml"
+# 29060 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 1007 "parsing/parser.mly"
( [x] )
-# 28951 "parsing/parser.ml"
+# 29065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3019 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 28988 "parsing/parser.ml"
+# 29102 "parsing/parser.ml"
in
-# 989 "parsing/parser.mly"
+# 1011 "parsing/parser.mly"
( x :: xs )
-# 28993 "parsing/parser.ml"
+# 29107 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) =
-# 848 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( [] )
-# 29011 "parsing/parser.ml"
+# 29125 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1914 "parsing/parser.mly"
+# 1934 "parsing/parser.mly"
( _1, _3, make_loc _sloc )
-# 29070 "parsing/parser.ml"
+# 29184 "parsing/parser.ml"
in
# 183 "menhir/standard.mly"
( x )
-# 29076 "parsing/parser.ml"
+# 29190 "parsing/parser.ml"
in
-# 850 "parsing/parser.mly"
+# 872 "parsing/parser.mly"
( x :: xs )
-# 29082 "parsing/parser.ml"
+# 29196 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_x_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let x : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic x in
+ let x : (Parsetree.functor_parameter) = Obj.magic x in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
- let _v : ((string Asttypes.loc * Parsetree.module_type option) list) =
-# 862 "parsing/parser.mly"
+ let _v : (Parsetree.functor_parameter list) =
+# 884 "parsing/parser.mly"
( [ x ] )
-# 29107 "parsing/parser.ml"
+# 29221 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
- let x : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic x in
- let xs : ((string Asttypes.loc * Parsetree.module_type option) list) = Obj.magic xs in
+ let x : (Parsetree.functor_parameter) = Obj.magic x in
+ let xs : (Parsetree.functor_parameter list) = Obj.magic xs in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
- let _v : ((string Asttypes.loc * Parsetree.module_type option) list) =
-# 864 "parsing/parser.mly"
+ let _v : (Parsetree.functor_parameter list) =
+# 886 "parsing/parser.mly"
( x :: xs )
-# 29139 "parsing/parser.ml"
+# 29253 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 862 "parsing/parser.mly"
+# 884 "parsing/parser.mly"
( [ x ] )
-# 29164 "parsing/parser.ml"
+# 29278 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 864 "parsing/parser.mly"
+# 886 "parsing/parser.mly"
( x :: xs )
-# 29196 "parsing/parser.ml"
+# 29310 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 862 "parsing/parser.mly"
+# 884 "parsing/parser.mly"
( [ x ] )
-# 29221 "parsing/parser.ml"
+# 29335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 864 "parsing/parser.mly"
+# 886 "parsing/parser.mly"
( x :: xs )
-# 29253 "parsing/parser.ml"
+# 29367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 29291 "parsing/parser.ml"
+# 29405 "parsing/parser.ml"
in
-# 3073 "parsing/parser.mly"
+# 3096 "parsing/parser.mly"
( _2 )
-# 29297 "parsing/parser.ml"
+# 29411 "parsing/parser.ml"
in
-# 862 "parsing/parser.mly"
+# 884 "parsing/parser.mly"
( [ x ] )
-# 29303 "parsing/parser.ml"
+# 29417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 29348 "parsing/parser.ml"
+# 29462 "parsing/parser.ml"
in
-# 3073 "parsing/parser.mly"
+# 3096 "parsing/parser.mly"
( _2 )
-# 29354 "parsing/parser.ml"
+# 29468 "parsing/parser.ml"
in
-# 864 "parsing/parser.mly"
+# 886 "parsing/parser.mly"
( x :: xs )
-# 29360 "parsing/parser.ml"
+# 29474 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.case list) = let _1 =
# 124 "menhir/standard.mly"
( None )
-# 29385 "parsing/parser.ml"
+# 29499 "parsing/parser.ml"
in
-# 953 "parsing/parser.mly"
+# 975 "parsing/parser.mly"
( [x] )
-# 29390 "parsing/parser.ml"
+# 29504 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "menhir/standard.mly"
( Some x )
-# 29424 "parsing/parser.ml"
+# 29538 "parsing/parser.ml"
in
-# 953 "parsing/parser.mly"
+# 975 "parsing/parser.mly"
( [x] )
-# 29430 "parsing/parser.ml"
+# 29544 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.case list) =
-# 957 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( x :: xs )
-# 29469 "parsing/parser.ml"
+# 29583 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 29495 "parsing/parser.ml"
+# 29609 "parsing/parser.ml"
in
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 29500 "parsing/parser.ml"
+# 29614 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29506 "parsing/parser.ml"
+# 29620 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 29546 "parsing/parser.ml"
+# 29660 "parsing/parser.ml"
in
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 29551 "parsing/parser.ml"
+# 29665 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29557 "parsing/parser.ml"
+# 29671 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 29582 "parsing/parser.ml"
+# 29696 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29587 "parsing/parser.ml"
+# 29701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 29626 "parsing/parser.ml"
+# 29740 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29631 "parsing/parser.ml"
+# 29745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 29656 "parsing/parser.ml"
+# 29770 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29661 "parsing/parser.ml"
+# 29775 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 29700 "parsing/parser.ml"
+# 29814 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29705 "parsing/parser.ml"
+# 29819 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 29730 "parsing/parser.ml"
+# 29844 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29735 "parsing/parser.ml"
+# 29849 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 29774 "parsing/parser.ml"
+# 29888 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29779 "parsing/parser.ml"
+# 29893 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * Asttypes.variance) list) = let xs =
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 29804 "parsing/parser.ml"
+# 29918 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29809 "parsing/parser.ml"
+# 29923 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * Asttypes.variance) list) = let xs =
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 29848 "parsing/parser.ml"
+# 29962 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29853 "parsing/parser.ml"
+# 29967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 888 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( [ x ] )
-# 29878 "parsing/parser.ml"
+# 29992 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29883 "parsing/parser.ml"
+# 29997 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 892 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( x :: xs )
-# 29922 "parsing/parser.ml"
+# 30036 "parsing/parser.ml"
in
-# 896 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( xs )
-# 29927 "parsing/parser.ml"
+# 30041 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 919 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( x :: xs )
-# 29966 "parsing/parser.ml"
+# 30080 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 923 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30005 "parsing/parser.ml"
+# 30119 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.expression list) =
-# 919 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( x :: xs )
-# 30044 "parsing/parser.ml"
+# 30158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.expression list) =
-# 923 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30083 "parsing/parser.ml"
+# 30197 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 919 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( x :: xs )
-# 30122 "parsing/parser.ml"
+# 30236 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 923 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30161 "parsing/parser.ml"
+# 30275 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.row_field) =
-# 3256 "parsing/parser.mly"
+# 3279 "parsing/parser.mly"
( _1 )
-# 30186 "parsing/parser.ml"
+# 30300 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3258 "parsing/parser.mly"
+# 3281 "parsing/parser.mly"
( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
-# 30214 "parsing/parser.ml"
+# 30328 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression list) = let _2 =
# 124 "menhir/standard.mly"
( None )
-# 30239 "parsing/parser.ml"
+# 30353 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30244 "parsing/parser.ml"
+# 30358 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "menhir/standard.mly"
( Some x )
-# 30278 "parsing/parser.ml"
+# 30392 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30284 "parsing/parser.ml"
+# 30398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.expression list) =
-# 944 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30323 "parsing/parser.ml"
+# 30437 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 30351 "parsing/parser.ml"
+# 30465 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "menhir/standard.mly"
( None )
-# 30359 "parsing/parser.ml"
+# 30473 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 30366 "parsing/parser.ml"
+# 30480 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30374 "parsing/parser.ml"
+# 30488 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2501 "parsing/parser.mly"
+# 2524 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 30392 "parsing/parser.ml"
+# 30506 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30398 "parsing/parser.ml"
+# 30512 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x : unit = Obj.magic x in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 30433 "parsing/parser.ml"
+# 30547 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 =
# 126 "menhir/standard.mly"
( Some x )
-# 30441 "parsing/parser.ml"
+# 30555 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 30448 "parsing/parser.ml"
+# 30562 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30456 "parsing/parser.ml"
+# 30570 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2501 "parsing/parser.mly"
+# 2524 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 30474 "parsing/parser.ml"
+# 30588 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30480 "parsing/parser.ml"
+# 30594 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : unit = Obj.magic _2 in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 30522 "parsing/parser.ml"
+# 30636 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let x =
let label =
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 30532 "parsing/parser.ml"
+# 30646 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30540 "parsing/parser.ml"
+# 30654 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2501 "parsing/parser.mly"
+# 2524 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 30558 "parsing/parser.ml"
+# 30672 "parsing/parser.ml"
in
-# 944 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30564 "parsing/parser.ml"
+# 30678 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern list) = let _2 =
# 124 "menhir/standard.mly"
( None )
-# 30589 "parsing/parser.ml"
+# 30703 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30594 "parsing/parser.ml"
+# 30708 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "menhir/standard.mly"
( Some x )
-# 30628 "parsing/parser.ml"
+# 30742 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30634 "parsing/parser.ml"
+# 30748 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.pattern list) =
-# 944 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30673 "parsing/parser.ml"
+# 30787 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "menhir/standard.mly"
( None )
-# 30712 "parsing/parser.ml"
+# 30826 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30722 "parsing/parser.ml"
+# 30836 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2484 "parsing/parser.mly"
+# 2507 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 30740 "parsing/parser.ml"
+# 30854 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30746 "parsing/parser.ml"
+# 30860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 126 "menhir/standard.mly"
( Some x )
-# 30792 "parsing/parser.ml"
+# 30906 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30802 "parsing/parser.ml"
+# 30916 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2484 "parsing/parser.mly"
+# 2507 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 30820 "parsing/parser.ml"
+# 30934 "parsing/parser.ml"
in
-# 940 "parsing/parser.mly"
+# 962 "parsing/parser.mly"
( [x] )
-# 30826 "parsing/parser.ml"
+# 30940 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30884 "parsing/parser.ml"
+# 30998 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2484 "parsing/parser.mly"
+# 2507 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 30902 "parsing/parser.ml"
+# 31016 "parsing/parser.ml"
in
-# 944 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30908 "parsing/parser.ml"
+# 31022 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2003 "parsing/parser.mly"
+# 2023 "parsing/parser.mly"
( _1 )
-# 30933 "parsing/parser.ml"
+# 31047 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2004 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( _1 )
-# 30965 "parsing/parser.ml"
+# 31079 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2006 "parsing/parser.mly"
+# 2026 "parsing/parser.mly"
( Pexp_sequence(_1, _3) )
-# 31005 "parsing/parser.ml"
+# 31119 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 31014 "parsing/parser.ml"
+# 31128 "parsing/parser.ml"
in
-# 2007 "parsing/parser.mly"
+# 2027 "parsing/parser.mly"
( _1 )
-# 31020 "parsing/parser.ml"
+# 31134 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2009 "parsing/parser.mly"
+# 2029 "parsing/parser.mly"
( let seq = mkexp ~loc:_sloc (Pexp_sequence (_1, _5)) in
let payload = PStr [mkstrexp seq []] in
mkexp ~loc:_sloc (Pexp_extension (_4, payload)) )
-# 31078 "parsing/parser.ml"
+# 31192 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 31147 "parsing/parser.ml"
+# 31261 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined4_ in
let attrs2 =
let _1 = _1_inlined3 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 31156 "parsing/parser.ml"
+# 31270 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31167 "parsing/parser.ml"
+# 31281 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 31175 "parsing/parser.ml"
+# 31289 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2937 "parsing/parser.mly"
+# 2960 "parsing/parser.mly"
( let args, res = args_res in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
(Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 31189 "parsing/parser.ml"
+# 31303 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 31215 "parsing/parser.ml"
+# 31329 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 763 "parsing/parser.mly"
+# 785 "parsing/parser.mly"
( extra_sig _startpos _endpos _1 )
-# 31223 "parsing/parser.ml"
+# 31337 "parsing/parser.ml"
in
-# 1471 "parsing/parser.mly"
+# 1492 "parsing/parser.mly"
( _1 )
-# 31229 "parsing/parser.ml"
+# 31343 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item) = let _2 =
let _1 = _1_inlined1 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 31263 "parsing/parser.ml"
+# 31377 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1486 "parsing/parser.mly"
+# 1507 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
-# 31274 "parsing/parser.ml"
+# 31388 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1490 "parsing/parser.mly"
+# 1511 "parsing/parser.mly"
( Psig_attribute _1 )
-# 31300 "parsing/parser.ml"
+# 31414 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 811 "parsing/parser.mly"
+# 833 "parsing/parser.mly"
( mksig ~loc:_sloc _1 )
-# 31308 "parsing/parser.ml"
+# 31422 "parsing/parser.ml"
in
-# 1492 "parsing/parser.mly"
+# 1513 "parsing/parser.mly"
( _1 )
-# 31314 "parsing/parser.ml"
+# 31428 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1495 "parsing/parser.mly"
+# 1516 "parsing/parser.mly"
( psig_value _1 )
-# 31340 "parsing/parser.ml"
+# 31454 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31348 "parsing/parser.ml"
+# 31462 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31354 "parsing/parser.ml"
+# 31468 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1497 "parsing/parser.mly"
+# 1518 "parsing/parser.mly"
( psig_value _1 )
-# 31380 "parsing/parser.ml"
+# 31494 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31388 "parsing/parser.ml"
+# 31502 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31394 "parsing/parser.ml"
+# 31508 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 31431 "parsing/parser.ml"
+# 31545 "parsing/parser.ml"
in
-# 2769 "parsing/parser.mly"
+# 2792 "parsing/parser.mly"
( _1 )
-# 31436 "parsing/parser.ml"
+# 31550 "parsing/parser.ml"
in
-# 2752 "parsing/parser.mly"
+# 2775 "parsing/parser.mly"
( _1 )
-# 31442 "parsing/parser.ml"
+# 31556 "parsing/parser.ml"
in
-# 1499 "parsing/parser.mly"
+# 1520 "parsing/parser.mly"
( psig_type _1 )
-# 31448 "parsing/parser.ml"
+# 31562 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31458 "parsing/parser.ml"
+# 31572 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31464 "parsing/parser.ml"
+# 31578 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 31501 "parsing/parser.ml"
+# 31615 "parsing/parser.ml"
in
-# 2769 "parsing/parser.mly"
+# 2792 "parsing/parser.mly"
( _1 )
-# 31506 "parsing/parser.ml"
+# 31620 "parsing/parser.ml"
in
-# 2757 "parsing/parser.mly"
+# 2780 "parsing/parser.mly"
( _1 )
-# 31512 "parsing/parser.ml"
+# 31626 "parsing/parser.ml"
in
-# 1501 "parsing/parser.mly"
+# 1522 "parsing/parser.mly"
( psig_typesubst _1 )
-# 31518 "parsing/parser.ml"
+# 31632 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31528 "parsing/parser.ml"
+# 31642 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31534 "parsing/parser.ml"
+# 31648 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 31621 "parsing/parser.ml"
+# 31735 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 993 "parsing/parser.mly"
+# 1015 "parsing/parser.mly"
( List.rev xs )
-# 31628 "parsing/parser.ml"
+# 31742 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31638 "parsing/parser.ml"
+# 31752 "parsing/parser.ml"
in
let _4 =
-# 3485 "parsing/parser.mly"
+# 3512 "parsing/parser.mly"
( Recursive )
-# 31644 "parsing/parser.ml"
+# 31758 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 31651 "parsing/parser.ml"
+# 31765 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3006 "parsing/parser.mly"
+# 3029 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 31663 "parsing/parser.ml"
+# 31777 "parsing/parser.ml"
in
-# 2993 "parsing/parser.mly"
+# 3016 "parsing/parser.mly"
( _1 )
-# 31669 "parsing/parser.ml"
+# 31783 "parsing/parser.ml"
in
-# 1503 "parsing/parser.mly"
+# 1524 "parsing/parser.mly"
( psig_typext _1 )
-# 31675 "parsing/parser.ml"
+# 31789 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31685 "parsing/parser.ml"
+# 31799 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31691 "parsing/parser.ml"
+# 31805 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 31785 "parsing/parser.ml"
+# 31899 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 993 "parsing/parser.mly"
+# 1015 "parsing/parser.mly"
( List.rev xs )
-# 31792 "parsing/parser.ml"
+# 31906 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31802 "parsing/parser.ml"
+# 31916 "parsing/parser.ml"
in
let _4 =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3486 "parsing/parser.mly"
+# 3513 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 31813 "parsing/parser.ml"
+# 31927 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 31821 "parsing/parser.ml"
+# 31935 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3006 "parsing/parser.mly"
+# 3029 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 31833 "parsing/parser.ml"
+# 31947 "parsing/parser.ml"
in
-# 2993 "parsing/parser.mly"
+# 3016 "parsing/parser.mly"
( _1 )
-# 31839 "parsing/parser.ml"
+# 31953 "parsing/parser.ml"
in
-# 1503 "parsing/parser.mly"
+# 1524 "parsing/parser.mly"
( psig_typext _1 )
-# 31845 "parsing/parser.ml"
+# 31959 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31855 "parsing/parser.ml"
+# 31969 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31861 "parsing/parser.ml"
+# 31975 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1505 "parsing/parser.mly"
+# 1526 "parsing/parser.mly"
( psig_exception _1 )
-# 31887 "parsing/parser.ml"
+# 32001 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 31895 "parsing/parser.ml"
+# 32009 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 31901 "parsing/parser.ml"
+# 32015 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.module_type) = Obj.magic body in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 31954 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 31970 "parsing/parser.ml"
+# 32080 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31982 "parsing/parser.ml"
+# 32092 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 31990 "parsing/parser.ml"
+# 32100 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1534 "parsing/parser.mly"
+# 1555 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
- Md.mk uid body ~attrs ~loc ~docs, ext
+ Md.mk name body ~attrs ~loc ~docs, ext
)
-# 32004 "parsing/parser.ml"
+# 32114 "parsing/parser.ml"
in
-# 1507 "parsing/parser.mly"
+# 1528 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 32010 "parsing/parser.ml"
+# 32120 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32020 "parsing/parser.ml"
+# 32130 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32026 "parsing/parser.ml"
+# 32136 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 32086 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 32102 "parsing/parser.ml"
+# 32208 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32115 "parsing/parser.ml"
+# 32221 "parsing/parser.ml"
in
let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
let _symbolstartpos = _startpos_id_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1571 "parsing/parser.mly"
+# 1591 "parsing/parser.mly"
( Mty.alias ~loc:(make_loc _sloc) id )
-# 32125 "parsing/parser.ml"
+# 32231 "parsing/parser.ml"
in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32136 "parsing/parser.ml"
+# 32242 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 32144 "parsing/parser.ml"
+# 32250 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1562 "parsing/parser.mly"
+# 1582 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
- Md.mk uid body ~attrs ~loc ~docs, ext
+ Md.mk name body ~attrs ~loc ~docs, ext
)
-# 32158 "parsing/parser.ml"
+# 32264 "parsing/parser.ml"
in
-# 1509 "parsing/parser.mly"
+# 1530 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 32164 "parsing/parser.ml"
+# 32270 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32174 "parsing/parser.ml"
+# 32280 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32180 "parsing/parser.ml"
+# 32286 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1511 "parsing/parser.mly"
+# 1532 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modsubst body, ext) )
-# 32206 "parsing/parser.ml"
+# 32312 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32214 "parsing/parser.ml"
+# 32320 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32220 "parsing/parser.ml"
+# 32326 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let mty : (Parsetree.module_type) = Obj.magic mty in
let _6 : unit = Obj.magic _6 in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 32293 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _4 : unit = Obj.magic _4 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 32312 "parsing/parser.ml"
+# 32414 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32324 "parsing/parser.ml"
+# 32426 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 32332 "parsing/parser.ml"
+# 32434 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1605 "parsing/parser.mly"
+# 1625 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
- ext, Md.mk uid mty ~attrs ~loc ~docs
+ ext, Md.mk name mty ~attrs ~loc ~docs
)
-# 32346 "parsing/parser.ml"
+# 32448 "parsing/parser.ml"
in
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32352 "parsing/parser.ml"
+# 32454 "parsing/parser.ml"
in
-# 1594 "parsing/parser.mly"
+# 1614 "parsing/parser.mly"
( _1 )
-# 32358 "parsing/parser.ml"
+# 32460 "parsing/parser.ml"
in
-# 1513 "parsing/parser.mly"
+# 1534 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_recmodule l, ext) )
-# 32364 "parsing/parser.ml"
+# 32466 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32374 "parsing/parser.ml"
+# 32476 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32380 "parsing/parser.ml"
+# 32482 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1515 "parsing/parser.mly"
+# 1536 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modtype body, ext) )
-# 32406 "parsing/parser.ml"
+# 32508 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32414 "parsing/parser.ml"
+# 32516 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32420 "parsing/parser.ml"
+# 32522 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1517 "parsing/parser.mly"
+# 1538 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_open body, ext) )
-# 32446 "parsing/parser.ml"
+# 32548 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32454 "parsing/parser.ml"
+# 32556 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32460 "parsing/parser.ml"
+# 32562 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 32518 "parsing/parser.ml"
+# 32620 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 32527 "parsing/parser.ml"
+# 32629 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1363 "parsing/parser.mly"
+# 1384 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Incl.mk thing ~attrs ~loc ~docs, ext
)
-# 32541 "parsing/parser.ml"
+# 32643 "parsing/parser.ml"
in
-# 1519 "parsing/parser.mly"
+# 1540 "parsing/parser.mly"
( psig_include _1 )
-# 32547 "parsing/parser.ml"
+# 32649 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32557 "parsing/parser.ml"
+# 32659 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32563 "parsing/parser.ml"
+# 32665 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.class_type) = Obj.magic cty in
let _7 : unit = Obj.magic _7 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 32642 "parsing/parser.ml"
+# 32744 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 32662 "parsing/parser.ml"
+# 32764 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32674 "parsing/parser.ml"
+# 32776 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 32682 "parsing/parser.ml"
+# 32784 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1935 "parsing/parser.mly"
+# 1955 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
)
-# 32697 "parsing/parser.ml"
+# 32799 "parsing/parser.ml"
in
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32703 "parsing/parser.ml"
+# 32805 "parsing/parser.ml"
in
-# 1923 "parsing/parser.mly"
+# 1943 "parsing/parser.mly"
( _1 )
-# 32709 "parsing/parser.ml"
+# 32811 "parsing/parser.ml"
in
-# 1521 "parsing/parser.mly"
+# 1542 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class l, ext) )
-# 32715 "parsing/parser.ml"
+# 32817 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32725 "parsing/parser.ml"
+# 32827 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32731 "parsing/parser.ml"
+# 32833 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1523 "parsing/parser.mly"
+# 1544 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class_type l, ext) )
-# 32757 "parsing/parser.ml"
+# 32859 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 828 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32765 "parsing/parser.ml"
+# 32867 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1546 "parsing/parser.mly"
( _1 )
-# 32771 "parsing/parser.ml"
+# 32873 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3332 "parsing/parser.mly"
+# 3355 "parsing/parser.mly"
( _1 )
-# 32796 "parsing/parser.ml"
+# 32898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 606 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string * char option)
-# 32823 "parsing/parser.ml"
+# 32925 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3333 "parsing/parser.mly"
+# 3356 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
-# 32832 "parsing/parser.ml"
+# 32934 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 585 "parsing/parser.mly"
+# 607 "parsing/parser.mly"
(string * char option)
-# 32859 "parsing/parser.ml"
+# 32961 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3334 "parsing/parser.mly"
+# 3357 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
-# 32868 "parsing/parser.ml"
+# 32970 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 606 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string * char option)
-# 32895 "parsing/parser.ml"
+# 32997 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3335 "parsing/parser.mly"
+# 3358 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer (n, m) )
-# 32904 "parsing/parser.ml"
+# 33006 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 585 "parsing/parser.mly"
+# 607 "parsing/parser.mly"
(string * char option)
-# 32931 "parsing/parser.ml"
+# 33033 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3336 "parsing/parser.mly"
+# 3359 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float(f, m) )
-# 32940 "parsing/parser.ml"
+# 33042 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2684 "parsing/parser.mly"
+# 2707 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 32985 "parsing/parser.ml"
+# 33087 "parsing/parser.ml"
in
-# 2655 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( let (fields, closed) = _2 in
Ppat_record(fields, closed) )
-# 32992 "parsing/parser.ml"
+# 33094 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33002 "parsing/parser.ml"
+# 33104 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33008 "parsing/parser.ml"
+# 33110 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2684 "parsing/parser.mly"
+# 2707 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 33053 "parsing/parser.ml"
+# 33155 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2658 "parsing/parser.mly"
+# 2681 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 33061 "parsing/parser.ml"
+# 33163 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33071 "parsing/parser.ml"
+# 33173 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33077 "parsing/parser.ml"
+# 33179 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2678 "parsing/parser.mly"
+# 2701 "parsing/parser.mly"
( ps )
-# 33118 "parsing/parser.ml"
+# 33220 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2660 "parsing/parser.mly"
+# 2683 "parsing/parser.mly"
( fst (mktailpat _loc__3_ _2) )
-# 33124 "parsing/parser.ml"
+# 33226 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33134 "parsing/parser.ml"
+# 33236 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33140 "parsing/parser.ml"
+# 33242 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2678 "parsing/parser.mly"
+# 2701 "parsing/parser.mly"
( ps )
-# 33181 "parsing/parser.ml"
+# 33283 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2662 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 33188 "parsing/parser.ml"
+# 33290 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33198 "parsing/parser.ml"
+# 33300 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33204 "parsing/parser.ml"
+# 33306 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2678 "parsing/parser.mly"
+# 2701 "parsing/parser.mly"
( ps )
-# 33245 "parsing/parser.ml"
+# 33347 "parsing/parser.ml"
in
-# 2664 "parsing/parser.mly"
+# 2687 "parsing/parser.mly"
( Ppat_array _2 )
-# 33250 "parsing/parser.ml"
+# 33352 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33260 "parsing/parser.ml"
+# 33362 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33266 "parsing/parser.ml"
+# 33368 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2666 "parsing/parser.mly"
+# 2689 "parsing/parser.mly"
( Ppat_array [] )
-# 33299 "parsing/parser.ml"
+# 33401 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33308 "parsing/parser.ml"
+# 33410 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33314 "parsing/parser.ml"
+# 33416 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2678 "parsing/parser.mly"
+# 2701 "parsing/parser.mly"
( ps )
-# 33355 "parsing/parser.ml"
+# 33457 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2668 "parsing/parser.mly"
+# 2691 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 33362 "parsing/parser.ml"
+# 33464 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33372 "parsing/parser.ml"
+# 33474 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2692 "parsing/parser.mly"
( _1 )
-# 33378 "parsing/parser.ml"
+# 33480 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2167 "parsing/parser.mly"
+# 2190 "parsing/parser.mly"
( reloc_exp ~loc:_sloc _2 )
-# 33420 "parsing/parser.ml"
+# 33522 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2169 "parsing/parser.mly"
+# 2192 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 33461 "parsing/parser.ml"
+# 33563 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2171 "parsing/parser.mly"
+# 2194 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _2 _3 )
-# 33510 "parsing/parser.ml"
+# 33612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2173 "parsing/parser.mly"
+# 2196 "parsing/parser.mly"
( array_get ~loc:_sloc _1 _4 )
-# 33566 "parsing/parser.ml"
+# 33668 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2175 "parsing/parser.mly"
+# 2198 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 33621 "parsing/parser.ml"
+# 33723 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2177 "parsing/parser.mly"
+# 2200 "parsing/parser.mly"
( string_get ~loc:_sloc _1 _4 )
-# 33677 "parsing/parser.ml"
+# 33779 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2179 "parsing/parser.mly"
+# 2202 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 33732 "parsing/parser.ml"
+# 33834 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 33780 "parsing/parser.ml"
+# 33882 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 33891 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2181 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (Lident ("." ^ _2 ^ "[]")) _1 _4 )
-# 33792 "parsing/parser.ml"
+# 2204 "parsing/parser.mly"
+ ( dotop_get ~loc:_sloc lident bracket _2 _1 _4 )
+# 33899 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 33840 "parsing/parser.ml"
+# 33947 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 33956 "parsing/parser.ml"
+ in
+ let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2183 "parsing/parser.mly"
+# 2206 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 33851 "parsing/parser.ml"
+# 33963 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 33899 "parsing/parser.ml"
+# 34011 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34020 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2185 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (Lident ("." ^ _2 ^ "()")) _1 _4 )
-# 33911 "parsing/parser.ml"
+# 2208 "parsing/parser.mly"
+ ( dotop_get ~loc:_sloc lident paren _2 _1 _4 )
+# 34028 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 33959 "parsing/parser.ml"
+# 34076 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34085 "parsing/parser.ml"
+ in
+ let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2187 "parsing/parser.mly"
+# 2210 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 33970 "parsing/parser.ml"
+# 34092 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34018 "parsing/parser.ml"
+# 34140 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _4 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34149 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2189 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (Lident ("." ^ _2 ^ "{}")) _1 _4 )
-# 34030 "parsing/parser.ml"
+# 2212 "parsing/parser.mly"
+ ( dotop_get ~loc:_sloc lident brace _2 _1 _4 )
+# 34157 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _4 : (Parsetree.expression) = Obj.magic _4 in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34078 "parsing/parser.ml"
+# 34205 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2191 "parsing/parser.mly"
+# 2214 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 34089 "parsing/parser.ml"
+# 34216 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
};
} = _menhir_stack in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34149 "parsing/parser.ml"
+# 34276 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34287 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2193 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "[]")) _1 _6 )
-# 34163 "parsing/parser.ml"
+# 2216 "parsing/parser.mly"
+ ( dotop_get ~loc:_sloc (ldot _3) bracket _4 _1 _6 )
+# 34295 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
};
} = _menhir_stack in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34223 "parsing/parser.ml"
+# 34355 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _loc__7_ = (_startpos__7_, _endpos__7_) in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34366 "parsing/parser.ml"
+ in
+ let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2196 "parsing/parser.mly"
+# 2219 "parsing/parser.mly"
( unclosed "[" _loc__5_ "]" _loc__7_ )
-# 34236 "parsing/parser.ml"
+# 34373 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
};
} = _menhir_stack in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34296 "parsing/parser.ml"
+# 34433 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34444 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2198 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "()")) _1 _6 )
-# 34310 "parsing/parser.ml"
+# 2221 "parsing/parser.mly"
+ ( dotop_get ~loc:_sloc (ldot _3) paren _4 _1 _6 )
+# 34452 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
};
} = _menhir_stack in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34370 "parsing/parser.ml"
+# 34512 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _loc__7_ = (_startpos__7_, _endpos__7_) in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34523 "parsing/parser.ml"
+ in
+ let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2201 "parsing/parser.mly"
+# 2224 "parsing/parser.mly"
( unclosed "(" _loc__5_ ")" _loc__7_ )
-# 34383 "parsing/parser.ml"
+# 34530 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
};
} = _menhir_stack in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34443 "parsing/parser.ml"
+# 34590 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34601 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2203 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "{}")) _1 _6 )
-# 34457 "parsing/parser.ml"
+# 2226 "parsing/parser.mly"
+ ( dotop_get ~loc:_sloc (ldot _3) brace _4 _1 _6 )
+# 34609 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__7_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
};
} = _menhir_stack in
let _7 : unit = Obj.magic _7 in
- let _6 : (Parsetree.expression) = Obj.magic _6 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 601 "parsing/parser.mly"
+# 623 "parsing/parser.mly"
(string)
-# 34517 "parsing/parser.ml"
+# 34669 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _loc__7_ = (_startpos__7_, _endpos__7_) in
+ let _v : (Parsetree.expression) = let _6 =
+# 2536 "parsing/parser.mly"
+ ( es )
+# 34680 "parsing/parser.ml"
+ in
+ let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2206 "parsing/parser.mly"
+# 2229 "parsing/parser.mly"
( unclosed "{" _loc__5_ "}" _loc__7_ )
-# 34530 "parsing/parser.ml"
+# 34687 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2208 "parsing/parser.mly"
+# 2231 "parsing/parser.mly"
( bigarray_get ~loc:_sloc _1 _4 )
-# 34586 "parsing/parser.ml"
+# 34743 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2210 "parsing/parser.mly"
+# 2233 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 34641 "parsing/parser.ml"
+# 34798 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 34697 "parsing/parser.ml"
+# 34854 "parsing/parser.ml"
in
-# 2219 "parsing/parser.mly"
+# 2242 "parsing/parser.mly"
( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
-# 34703 "parsing/parser.ml"
+# 34860 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 34714 "parsing/parser.ml"
+# 34871 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 34765 "parsing/parser.ml"
+# 34922 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 34771 "parsing/parser.ml"
+# 34928 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2221 "parsing/parser.mly"
+# 2244 "parsing/parser.mly"
( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
-# 34780 "parsing/parser.ml"
+# 34937 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 34791 "parsing/parser.ml"
+# 34948 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 34849 "parsing/parser.ml"
+# 35006 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 34855 "parsing/parser.ml"
+# 35012 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2223 "parsing/parser.mly"
+# 2246 "parsing/parser.mly"
( unclosed "begin" _loc__1_ "end" _loc__4_ )
-# 34863 "parsing/parser.ml"
+# 35020 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 34874 "parsing/parser.ml"
+# 35031 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 34926 "parsing/parser.ml"
+# 35083 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 34936 "parsing/parser.ml"
+# 35093 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 34942 "parsing/parser.ml"
+# 35099 "parsing/parser.ml"
in
-# 2225 "parsing/parser.mly"
+# 2248 "parsing/parser.mly"
( Pexp_new(_3), _2 )
-# 34948 "parsing/parser.ml"
+# 35105 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 34959 "parsing/parser.ml"
+# 35116 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 35024 "parsing/parser.ml"
+# 35181 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 35030 "parsing/parser.ml"
+# 35187 "parsing/parser.ml"
in
-# 2227 "parsing/parser.mly"
+# 2250 "parsing/parser.mly"
( Pexp_pack _4, _3 )
-# 35036 "parsing/parser.ml"
+# 35193 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35047 "parsing/parser.ml"
+# 35204 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 35125 "parsing/parser.ml"
+# 35282 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 35133 "parsing/parser.ml"
+# 35290 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 35139 "parsing/parser.ml"
+# 35296 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 35149 "parsing/parser.ml"
+# 35306 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 35155 "parsing/parser.ml"
+# 35312 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2229 "parsing/parser.mly"
+# 2252 "parsing/parser.mly"
( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
-# 35164 "parsing/parser.ml"
+# 35321 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35175 "parsing/parser.ml"
+# 35332 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 35247 "parsing/parser.ml"
+# 35404 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 35253 "parsing/parser.ml"
+# 35410 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2231 "parsing/parser.mly"
+# 2254 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 35261 "parsing/parser.ml"
+# 35418 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2212 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35272 "parsing/parser.ml"
+# 35429 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35303 "parsing/parser.ml"
+# 35460 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2258 "parsing/parser.mly"
( Pexp_ident (_1) )
-# 35309 "parsing/parser.ml"
+# 35466 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35318 "parsing/parser.ml"
+# 35475 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35324 "parsing/parser.ml"
+# 35481 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2237 "parsing/parser.mly"
+# 2260 "parsing/parser.mly"
( Pexp_constant _1 )
-# 35350 "parsing/parser.ml"
+# 35507 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35358 "parsing/parser.ml"
+# 35515 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35364 "parsing/parser.ml"
+# 35521 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35395 "parsing/parser.ml"
+# 35552 "parsing/parser.ml"
in
-# 2239 "parsing/parser.mly"
+# 2262 "parsing/parser.mly"
( Pexp_construct(_1, None) )
-# 35401 "parsing/parser.ml"
+# 35558 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35410 "parsing/parser.ml"
+# 35567 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35416 "parsing/parser.ml"
+# 35573 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2241 "parsing/parser.mly"
+# 2264 "parsing/parser.mly"
( Pexp_variant(_1, None) )
-# 35442 "parsing/parser.ml"
+# 35599 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35450 "parsing/parser.ml"
+# 35607 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35456 "parsing/parser.ml"
+# 35613 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 644 "parsing/parser.mly"
+# 666 "parsing/parser.mly"
(string)
-# 35484 "parsing/parser.ml"
+# 35641 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 35498 "parsing/parser.ml"
+# 35655 "parsing/parser.ml"
in
-# 2243 "parsing/parser.mly"
+# 2266 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 35504 "parsing/parser.ml"
+# 35661 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35514 "parsing/parser.ml"
+# 35671 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35520 "parsing/parser.ml"
+# 35677 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 2244 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
("!")
-# 35555 "parsing/parser.ml"
+# 35712 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 35563 "parsing/parser.ml"
+# 35720 "parsing/parser.ml"
in
-# 2245 "parsing/parser.mly"
+# 2268 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 35569 "parsing/parser.ml"
+# 35726 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35579 "parsing/parser.ml"
+# 35736 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35585 "parsing/parser.ml"
+# 35742 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2496 "parsing/parser.mly"
+# 2519 "parsing/parser.mly"
( xs )
-# 35626 "parsing/parser.ml"
+# 35783 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( Pexp_override _2 )
-# 35631 "parsing/parser.ml"
+# 35788 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35641 "parsing/parser.ml"
+# 35798 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35647 "parsing/parser.ml"
+# 35804 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2496 "parsing/parser.mly"
+# 2519 "parsing/parser.mly"
( xs )
-# 35688 "parsing/parser.ml"
+# 35845 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2249 "parsing/parser.mly"
+# 2272 "parsing/parser.mly"
( unclosed "{<" _loc__1_ ">}" _loc__3_ )
-# 35695 "parsing/parser.ml"
+# 35852 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35705 "parsing/parser.ml"
+# 35862 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35711 "parsing/parser.ml"
+# 35868 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2251 "parsing/parser.mly"
+# 2274 "parsing/parser.mly"
( Pexp_override [] )
-# 35744 "parsing/parser.ml"
+# 35901 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35753 "parsing/parser.ml"
+# 35910 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35759 "parsing/parser.ml"
+# 35916 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35805 "parsing/parser.ml"
+# 35962 "parsing/parser.ml"
in
-# 2253 "parsing/parser.mly"
+# 2276 "parsing/parser.mly"
( Pexp_field(_1, _3) )
-# 35811 "parsing/parser.ml"
+# 35968 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35821 "parsing/parser.ml"
+# 35978 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35827 "parsing/parser.ml"
+# 35984 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35887 "parsing/parser.ml"
+# 36044 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 35896 "parsing/parser.ml"
+# 36053 "parsing/parser.ml"
in
-# 2255 "parsing/parser.mly"
+# 2278 "parsing/parser.mly"
( Pexp_open(od, _4) )
-# 35902 "parsing/parser.ml"
+# 36059 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 35912 "parsing/parser.ml"
+# 36069 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 35918 "parsing/parser.ml"
+# 36075 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2496 "parsing/parser.mly"
+# 2519 "parsing/parser.mly"
( xs )
-# 35973 "parsing/parser.ml"
+# 36130 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35983 "parsing/parser.ml"
+# 36140 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 35992 "parsing/parser.ml"
+# 36149 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2257 "parsing/parser.mly"
+# 2280 "parsing/parser.mly"
( (* TODO: review the location of Pexp_override *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
-# 36003 "parsing/parser.ml"
+# 36160 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36013 "parsing/parser.ml"
+# 36170 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36019 "parsing/parser.ml"
+# 36176 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2496 "parsing/parser.mly"
+# 2519 "parsing/parser.mly"
( xs )
-# 36074 "parsing/parser.ml"
+# 36231 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2260 "parsing/parser.mly"
+# 2283 "parsing/parser.mly"
( unclosed "{<" _loc__3_ ">}" _loc__5_ )
-# 36081 "parsing/parser.ml"
+# 36238 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36091 "parsing/parser.ml"
+# 36248 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36097 "parsing/parser.ml"
+# 36254 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 36130 "parsing/parser.ml"
+# 36287 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _3 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 36144 "parsing/parser.ml"
+# 36301 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36152 "parsing/parser.ml"
+# 36309 "parsing/parser.ml"
in
-# 2262 "parsing/parser.mly"
+# 2285 "parsing/parser.mly"
( Pexp_send(_1, _3) )
-# 36158 "parsing/parser.ml"
+# 36315 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36168 "parsing/parser.ml"
+# 36325 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36174 "parsing/parser.ml"
+# 36331 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _1_inlined1 : (
-# 655 "parsing/parser.mly"
+# 677 "parsing/parser.mly"
(string)
-# 36208 "parsing/parser.ml"
+# 36365 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 797 "parsing/parser.mly"
+# 819 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 36224 "parsing/parser.ml"
+# 36381 "parsing/parser.ml"
in
-# 2264 "parsing/parser.mly"
+# 2287 "parsing/parser.mly"
( mkinfix _1 _2 _3 )
-# 36230 "parsing/parser.ml"
+# 36387 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36240 "parsing/parser.ml"
+# 36397 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36246 "parsing/parser.ml"
+# 36403 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2266 "parsing/parser.mly"
+# 2289 "parsing/parser.mly"
( Pexp_extension _1 )
-# 36272 "parsing/parser.ml"
+# 36429 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36280 "parsing/parser.ml"
+# 36437 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36286 "parsing/parser.ml"
+# 36443 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2267 "parsing/parser.mly"
+# 2290 "parsing/parser.mly"
(Lident "()")
-# 36336 "parsing/parser.ml"
+# 36493 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36345 "parsing/parser.ml"
+# 36502 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36357 "parsing/parser.ml"
+# 36514 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 36366 "parsing/parser.ml"
+# 36523 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2268 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( (* TODO: review the location of Pexp_construct *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) )
-# 36377 "parsing/parser.ml"
+# 36534 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36387 "parsing/parser.ml"
+# 36544 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36393 "parsing/parser.ml"
+# 36550 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2271 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 36450 "parsing/parser.ml"
+# 36607 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36460 "parsing/parser.ml"
+# 36617 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36466 "parsing/parser.ml"
+# 36623 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2273 "parsing/parser.mly"
+# 2296 "parsing/parser.mly"
( let (exten, fields) = _2 in
Pexp_record(fields, exten) )
-# 36508 "parsing/parser.ml"
+# 36665 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36517 "parsing/parser.ml"
+# 36674 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36523 "parsing/parser.ml"
+# 36680 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2276 "parsing/parser.mly"
+# 2299 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 36567 "parsing/parser.ml"
+# 36724 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36577 "parsing/parser.ml"
+# 36734 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36583 "parsing/parser.ml"
+# 36740 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36644 "parsing/parser.ml"
+# 36801 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 36653 "parsing/parser.ml"
+# 36810 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2278 "parsing/parser.mly"
+# 2301 "parsing/parser.mly"
( let (exten, fields) = _4 in
(* TODO: review the location of Pexp_construct *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_record(fields, exten))) )
-# 36665 "parsing/parser.ml"
+# 36822 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36675 "parsing/parser.ml"
+# 36832 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36681 "parsing/parser.ml"
+# 36838 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2282 "parsing/parser.mly"
+# 2305 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 36739 "parsing/parser.ml"
+# 36896 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36749 "parsing/parser.ml"
+# 36906 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36755 "parsing/parser.ml"
+# 36912 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 36796 "parsing/parser.ml"
+# 36953 "parsing/parser.ml"
in
-# 2284 "parsing/parser.mly"
+# 2307 "parsing/parser.mly"
( Pexp_array(_2) )
-# 36801 "parsing/parser.ml"
+# 36958 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36811 "parsing/parser.ml"
+# 36968 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36817 "parsing/parser.ml"
+# 36974 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 36858 "parsing/parser.ml"
+# 37015 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2286 "parsing/parser.mly"
+# 2309 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 36865 "parsing/parser.ml"
+# 37022 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36875 "parsing/parser.ml"
+# 37032 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36881 "parsing/parser.ml"
+# 37038 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2288 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
( Pexp_array [] )
-# 36914 "parsing/parser.ml"
+# 37071 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36923 "parsing/parser.ml"
+# 37080 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 36929 "parsing/parser.ml"
+# 37086 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 36984 "parsing/parser.ml"
+# 37141 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36994 "parsing/parser.ml"
+# 37151 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37003 "parsing/parser.ml"
+# 37160 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2290 "parsing/parser.mly"
+# 2313 "parsing/parser.mly"
( (* TODO: review the location of Pexp_array *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_array(_4))) )
-# 37014 "parsing/parser.ml"
+# 37171 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37024 "parsing/parser.ml"
+# 37181 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37030 "parsing/parser.ml"
+# 37187 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37083 "parsing/parser.ml"
+# 37240 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37092 "parsing/parser.ml"
+# 37249 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2293 "parsing/parser.mly"
+# 2316 "parsing/parser.mly"
( (* TODO: review the location of Pexp_array *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_array [])) )
-# 37103 "parsing/parser.ml"
+# 37260 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37113 "parsing/parser.ml"
+# 37270 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37119 "parsing/parser.ml"
+# 37276 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 37174 "parsing/parser.ml"
+# 37331 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2297 "parsing/parser.mly"
+# 2320 "parsing/parser.mly"
( unclosed "[|" _loc__3_ "|]" _loc__5_ )
-# 37181 "parsing/parser.ml"
+# 37338 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37191 "parsing/parser.ml"
+# 37348 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37197 "parsing/parser.ml"
+# 37354 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 37238 "parsing/parser.ml"
+# 37395 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2299 "parsing/parser.mly"
+# 2322 "parsing/parser.mly"
( fst (mktailexp _loc__3_ _2) )
-# 37244 "parsing/parser.ml"
+# 37401 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37254 "parsing/parser.ml"
+# 37411 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37260 "parsing/parser.ml"
+# 37417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 37301 "parsing/parser.ml"
+# 37458 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2301 "parsing/parser.mly"
+# 2324 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 37308 "parsing/parser.ml"
+# 37465 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37318 "parsing/parser.ml"
+# 37475 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37324 "parsing/parser.ml"
+# 37481 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 37379 "parsing/parser.ml"
+# 37536 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37389 "parsing/parser.ml"
+# 37546 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37398 "parsing/parser.ml"
+# 37555 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2303 "parsing/parser.mly"
+# 2326 "parsing/parser.mly"
( let list_exp =
(* TODO: review the location of list_exp *)
let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in
mkexp ~loc:_sloc tail_exp in
Pexp_open(od, list_exp) )
-# 37413 "parsing/parser.ml"
+# 37570 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37423 "parsing/parser.ml"
+# 37580 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37429 "parsing/parser.ml"
+# 37586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2308 "parsing/parser.mly"
+# 2331 "parsing/parser.mly"
(Lident "[]")
-# 37479 "parsing/parser.ml"
+# 37636 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37488 "parsing/parser.ml"
+# 37645 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37500 "parsing/parser.ml"
+# 37657 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37509 "parsing/parser.ml"
+# 37666 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2309 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( (* TODO: review the location of Pexp_construct *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) )
-# 37520 "parsing/parser.ml"
+# 37677 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37530 "parsing/parser.ml"
+# 37687 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37536 "parsing/parser.ml"
+# 37693 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2513 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( es )
-# 37591 "parsing/parser.ml"
+# 37748 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2313 "parsing/parser.mly"
+# 2336 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 37598 "parsing/parser.ml"
+# 37755 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37608 "parsing/parser.ml"
+# 37765 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37614 "parsing/parser.ml"
+# 37771 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 37707 "parsing/parser.ml"
+# 37864 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 37715 "parsing/parser.ml"
+# 37872 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 37721 "parsing/parser.ml"
+# 37878 "parsing/parser.ml"
in
let _5 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 37731 "parsing/parser.ml"
+# 37888 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 37737 "parsing/parser.ml"
+# 37894 "parsing/parser.ml"
in
let od =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37748 "parsing/parser.ml"
+# 37905 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1422 "parsing/parser.mly"
+# 1443 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37757 "parsing/parser.ml"
+# 37914 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2316 "parsing/parser.mly"
+# 2339 "parsing/parser.mly"
( (* TODO: review the location of Pexp_constraint *)
let modexp =
mkexp_attrs ~loc:_sloc
(Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in
Pexp_open(od, modexp) )
-# 37771 "parsing/parser.ml"
+# 37928 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37781 "parsing/parser.ml"
+# 37938 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37787 "parsing/parser.ml"
+# 37944 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 37874 "parsing/parser.ml"
+# 38031 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 37880 "parsing/parser.ml"
+# 38037 "parsing/parser.ml"
in
let _loc__8_ = (_startpos__8_, _endpos__8_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2323 "parsing/parser.mly"
+# 2346 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__8_ )
-# 37888 "parsing/parser.ml"
+# 38045 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 803 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37898 "parsing/parser.ml"
+# 38055 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2238 "parsing/parser.mly"
( _1 )
-# 37904 "parsing/parser.ml"
+# 38061 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37935 "parsing/parser.ml"
+# 38092 "parsing/parser.ml"
in
-# 2593 "parsing/parser.mly"
+# 2616 "parsing/parser.mly"
( Ppat_var (_1) )
-# 37941 "parsing/parser.ml"
+# 38098 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 37950 "parsing/parser.ml"
+# 38107 "parsing/parser.ml"
in
-# 2594 "parsing/parser.mly"
+# 2617 "parsing/parser.mly"
( _1 )
-# 37956 "parsing/parser.ml"
+# 38113 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2595 "parsing/parser.mly"
+# 2618 "parsing/parser.mly"
( _1 )
-# 37981 "parsing/parser.ml"
+# 38138 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2600 "parsing/parser.mly"
+# 2623 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 38023 "parsing/parser.ml"
+# 38180 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2602 "parsing/parser.mly"
+# 2625 "parsing/parser.mly"
( _1 )
-# 38048 "parsing/parser.ml"
+# 38205 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _1_inlined3 : (
-# 666 "parsing/parser.mly"
- (string)
-# 38100 "parsing/parser.ml"
- ) = Obj.magic _1_inlined3 in
+ let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38117 "parsing/parser.ml"
+# 38270 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 38127 "parsing/parser.ml"
+# 38280 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 38133 "parsing/parser.ml"
+# 38286 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2604 "parsing/parser.mly"
+# 2627 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
-# 38142 "parsing/parser.ml"
+# 38295 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _7 : unit = Obj.magic _7 in
let _1_inlined4 : (Parsetree.module_type) = Obj.magic _1_inlined4 in
let _5 : unit = Obj.magic _5 in
- let _1_inlined3 : (
-# 666 "parsing/parser.mly"
- (string)
-# 38208 "parsing/parser.ml"
- ) = Obj.magic _1_inlined3 in
+ let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 38223 "parsing/parser.ml"
+# 38372 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 38231 "parsing/parser.ml"
+# 38380 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 38237 "parsing/parser.ml"
+# 38386 "parsing/parser.ml"
in
let _4 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38248 "parsing/parser.ml"
+# 38397 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 38258 "parsing/parser.ml"
+# 38407 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 38264 "parsing/parser.ml"
+# 38413 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2606 "parsing/parser.mly"
+# 2629 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc
(Ppat_constraint(mkpat ~loc:_sloc (Ppat_unpack _4), _6))
_3 )
-# 38275 "parsing/parser.ml"
+# 38424 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2614 "parsing/parser.mly"
+# 2637 "parsing/parser.mly"
( Ppat_any )
-# 38301 "parsing/parser.ml"
+# 38450 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38309 "parsing/parser.ml"
+# 38458 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38315 "parsing/parser.ml"
+# 38464 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2616 "parsing/parser.mly"
+# 2639 "parsing/parser.mly"
( Ppat_constant _1 )
-# 38341 "parsing/parser.ml"
+# 38490 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38349 "parsing/parser.ml"
+# 38498 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38355 "parsing/parser.ml"
+# 38504 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2618 "parsing/parser.mly"
+# 2641 "parsing/parser.mly"
( Ppat_interval (_1, _3) )
-# 38395 "parsing/parser.ml"
+# 38544 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38404 "parsing/parser.ml"
+# 38553 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38410 "parsing/parser.ml"
+# 38559 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38441 "parsing/parser.ml"
+# 38590 "parsing/parser.ml"
in
-# 2620 "parsing/parser.mly"
+# 2643 "parsing/parser.mly"
( Ppat_construct(_1, None) )
-# 38447 "parsing/parser.ml"
+# 38596 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38456 "parsing/parser.ml"
+# 38605 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38462 "parsing/parser.ml"
+# 38611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2622 "parsing/parser.mly"
+# 2645 "parsing/parser.mly"
( Ppat_variant(_1, None) )
-# 38488 "parsing/parser.ml"
+# 38637 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38496 "parsing/parser.ml"
+# 38645 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38502 "parsing/parser.ml"
+# 38651 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38541 "parsing/parser.ml"
+# 38690 "parsing/parser.ml"
in
-# 2624 "parsing/parser.mly"
+# 2647 "parsing/parser.mly"
( Ppat_type (_2) )
-# 38547 "parsing/parser.ml"
+# 38696 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38557 "parsing/parser.ml"
+# 38706 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38563 "parsing/parser.ml"
+# 38712 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38608 "parsing/parser.ml"
+# 38757 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2649 "parsing/parser.mly"
( Ppat_open(_1, _3) )
-# 38614 "parsing/parser.ml"
+# 38763 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38624 "parsing/parser.ml"
+# 38773 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38630 "parsing/parser.ml"
+# 38779 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2627 "parsing/parser.mly"
+# 2650 "parsing/parser.mly"
(Lident "[]")
-# 38680 "parsing/parser.ml"
+# 38829 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38689 "parsing/parser.ml"
+# 38838 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38700 "parsing/parser.ml"
+# 38849 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2628 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 38709 "parsing/parser.ml"
+# 38858 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38719 "parsing/parser.ml"
+# 38868 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38725 "parsing/parser.ml"
+# 38874 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2629 "parsing/parser.mly"
+# 2652 "parsing/parser.mly"
(Lident "()")
-# 38775 "parsing/parser.ml"
+# 38924 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38784 "parsing/parser.ml"
+# 38933 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38795 "parsing/parser.ml"
+# 38944 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2630 "parsing/parser.mly"
+# 2653 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 38804 "parsing/parser.ml"
+# 38953 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38814 "parsing/parser.ml"
+# 38963 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38820 "parsing/parser.ml"
+# 38969 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38879 "parsing/parser.ml"
+# 39028 "parsing/parser.ml"
in
-# 2632 "parsing/parser.mly"
+# 2655 "parsing/parser.mly"
( Ppat_open (_1, _4) )
-# 38885 "parsing/parser.ml"
+# 39034 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38895 "parsing/parser.ml"
+# 39044 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38901 "parsing/parser.ml"
+# 39050 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2634 "parsing/parser.mly"
+# 2657 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 38958 "parsing/parser.ml"
+# 39107 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38968 "parsing/parser.ml"
+# 39117 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 38974 "parsing/parser.ml"
+# 39123 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2636 "parsing/parser.mly"
+# 2659 "parsing/parser.mly"
( expecting _loc__4_ "pattern" )
-# 39023 "parsing/parser.ml"
+# 39172 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39033 "parsing/parser.ml"
+# 39182 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39039 "parsing/parser.ml"
+# 39188 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2638 "parsing/parser.mly"
+# 2661 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 39082 "parsing/parser.ml"
+# 39231 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39092 "parsing/parser.ml"
+# 39241 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39098 "parsing/parser.ml"
+# 39247 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2640 "parsing/parser.mly"
+# 2663 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 39152 "parsing/parser.ml"
+# 39301 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39161 "parsing/parser.ml"
+# 39310 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39167 "parsing/parser.ml"
+# 39316 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2642 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 39224 "parsing/parser.ml"
+# 39373 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39234 "parsing/parser.ml"
+# 39383 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39240 "parsing/parser.ml"
+# 39389 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2644 "parsing/parser.mly"
+# 2667 "parsing/parser.mly"
( expecting _loc__4_ "type" )
-# 39289 "parsing/parser.ml"
+# 39438 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39299 "parsing/parser.ml"
+# 39448 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39305 "parsing/parser.ml"
+# 39454 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _7 : unit = Obj.magic _7 in
let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 666 "parsing/parser.mly"
- (string)
-# 39371 "parsing/parser.ml"
- ) = Obj.magic _4 in
+ let _4 : (string option) = Obj.magic _4 in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _1 =
let _1 =
-# 3247 "parsing/parser.mly"
+# 3270 "parsing/parser.mly"
( Ptyp_package (package_type_of_module_type _1) )
-# 39388 "parsing/parser.ml"
+# 39533 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 39396 "parsing/parser.ml"
+# 39541 "parsing/parser.ml"
in
-# 3248 "parsing/parser.mly"
+# 3271 "parsing/parser.mly"
( _1 )
-# 39402 "parsing/parser.ml"
+# 39547 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 39412 "parsing/parser.ml"
+# 39557 "parsing/parser.ml"
in
-# 3653 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( _1, _2 )
-# 39418 "parsing/parser.ml"
+# 39563 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2647 "parsing/parser.mly"
+# 2670 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__7_ )
-# 39426 "parsing/parser.ml"
+# 39571 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39436 "parsing/parser.ml"
+# 39581 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39442 "parsing/parser.ml"
+# 39587 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2649 "parsing/parser.mly"
+# 2672 "parsing/parser.mly"
( Ppat_extension _1 )
-# 39468 "parsing/parser.ml"
+# 39613 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 805 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39476 "parsing/parser.ml"
+# 39621 "parsing/parser.ml"
in
-# 2610 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( _1 )
-# 39482 "parsing/parser.ml"
+# 39627 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 39503 "parsing/parser.ml"
+# 39648 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3563 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( _1 )
-# 39511 "parsing/parser.ml"
+# 39656 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 666 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 39532 "parsing/parser.ml"
+# 39677 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3564 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( _1 )
-# 39540 "parsing/parser.ml"
+# 39685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3565 "parsing/parser.mly"
+# 3592 "parsing/parser.mly"
( "and" )
-# 39565 "parsing/parser.ml"
+# 39710 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3566 "parsing/parser.mly"
+# 3593 "parsing/parser.mly"
( "as" )
-# 39590 "parsing/parser.ml"
+# 39735 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3567 "parsing/parser.mly"
+# 3594 "parsing/parser.mly"
( "assert" )
-# 39615 "parsing/parser.ml"
+# 39760 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3568 "parsing/parser.mly"
+# 3595 "parsing/parser.mly"
( "begin" )
-# 39640 "parsing/parser.ml"
+# 39785 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3569 "parsing/parser.mly"
+# 3596 "parsing/parser.mly"
( "class" )
-# 39665 "parsing/parser.ml"
+# 39810 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3570 "parsing/parser.mly"
+# 3597 "parsing/parser.mly"
( "constraint" )
-# 39690 "parsing/parser.ml"
+# 39835 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3571 "parsing/parser.mly"
+# 3598 "parsing/parser.mly"
( "do" )
-# 39715 "parsing/parser.ml"
+# 39860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3572 "parsing/parser.mly"
+# 3599 "parsing/parser.mly"
( "done" )
-# 39740 "parsing/parser.ml"
+# 39885 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3573 "parsing/parser.mly"
+# 3600 "parsing/parser.mly"
( "downto" )
-# 39765 "parsing/parser.ml"
+# 39910 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3574 "parsing/parser.mly"
+# 3601 "parsing/parser.mly"
( "else" )
-# 39790 "parsing/parser.ml"
+# 39935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3575 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( "end" )
-# 39815 "parsing/parser.ml"
+# 39960 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3576 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( "exception" )
-# 39840 "parsing/parser.ml"
+# 39985 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3577 "parsing/parser.mly"
+# 3604 "parsing/parser.mly"
( "external" )
-# 39865 "parsing/parser.ml"
+# 40010 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3578 "parsing/parser.mly"
+# 3605 "parsing/parser.mly"
( "false" )
-# 39890 "parsing/parser.ml"
+# 40035 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3579 "parsing/parser.mly"
+# 3606 "parsing/parser.mly"
( "for" )
-# 39915 "parsing/parser.ml"
+# 40060 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3580 "parsing/parser.mly"
+# 3607 "parsing/parser.mly"
( "fun" )
-# 39940 "parsing/parser.ml"
+# 40085 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3581 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( "function" )
-# 39965 "parsing/parser.ml"
+# 40110 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3582 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( "functor" )
-# 39990 "parsing/parser.ml"
+# 40135 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3583 "parsing/parser.mly"
+# 3610 "parsing/parser.mly"
( "if" )
-# 40015 "parsing/parser.ml"
+# 40160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3584 "parsing/parser.mly"
+# 3611 "parsing/parser.mly"
( "in" )
-# 40040 "parsing/parser.ml"
+# 40185 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3585 "parsing/parser.mly"
+# 3612 "parsing/parser.mly"
( "include" )
-# 40065 "parsing/parser.ml"
+# 40210 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3586 "parsing/parser.mly"
+# 3613 "parsing/parser.mly"
( "inherit" )
-# 40090 "parsing/parser.ml"
+# 40235 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3587 "parsing/parser.mly"
+# 3614 "parsing/parser.mly"
( "initializer" )
-# 40115 "parsing/parser.ml"
+# 40260 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3588 "parsing/parser.mly"
+# 3615 "parsing/parser.mly"
( "lazy" )
-# 40140 "parsing/parser.ml"
+# 40285 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3589 "parsing/parser.mly"
+# 3616 "parsing/parser.mly"
( "let" )
-# 40165 "parsing/parser.ml"
+# 40310 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3590 "parsing/parser.mly"
+# 3617 "parsing/parser.mly"
( "match" )
-# 40190 "parsing/parser.ml"
+# 40335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3591 "parsing/parser.mly"
+# 3618 "parsing/parser.mly"
( "method" )
-# 40215 "parsing/parser.ml"
+# 40360 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3592 "parsing/parser.mly"
+# 3619 "parsing/parser.mly"
( "module" )
-# 40240 "parsing/parser.ml"
+# 40385 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3593 "parsing/parser.mly"
+# 3620 "parsing/parser.mly"
( "mutable" )
-# 40265 "parsing/parser.ml"
+# 40410 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3594 "parsing/parser.mly"
+# 3621 "parsing/parser.mly"
( "new" )
-# 40290 "parsing/parser.ml"
+# 40435 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3595 "parsing/parser.mly"
+# 3622 "parsing/parser.mly"
( "nonrec" )
-# 40315 "parsing/parser.ml"
+# 40460 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3596 "parsing/parser.mly"
+# 3623 "parsing/parser.mly"
( "object" )
-# 40340 "parsing/parser.ml"
+# 40485 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3597 "parsing/parser.mly"
+# 3624 "parsing/parser.mly"
( "of" )
-# 40365 "parsing/parser.ml"
+# 40510 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3598 "parsing/parser.mly"
+# 3625 "parsing/parser.mly"
( "open" )
-# 40390 "parsing/parser.ml"
+# 40535 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3599 "parsing/parser.mly"
+# 3626 "parsing/parser.mly"
( "or" )
-# 40415 "parsing/parser.ml"
+# 40560 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3600 "parsing/parser.mly"
+# 3627 "parsing/parser.mly"
( "private" )
-# 40440 "parsing/parser.ml"
+# 40585 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3601 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( "rec" )
-# 40465 "parsing/parser.ml"
+# 40610 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3602 "parsing/parser.mly"
+# 3629 "parsing/parser.mly"
( "sig" )
-# 40490 "parsing/parser.ml"
+# 40635 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3603 "parsing/parser.mly"
+# 3630 "parsing/parser.mly"
( "struct" )
-# 40515 "parsing/parser.ml"
+# 40660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3604 "parsing/parser.mly"
+# 3631 "parsing/parser.mly"
( "then" )
-# 40540 "parsing/parser.ml"
+# 40685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3605 "parsing/parser.mly"
+# 3632 "parsing/parser.mly"
( "to" )
-# 40565 "parsing/parser.ml"
+# 40710 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3606 "parsing/parser.mly"
+# 3633 "parsing/parser.mly"
( "true" )
-# 40590 "parsing/parser.ml"
+# 40735 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3607 "parsing/parser.mly"
+# 3634 "parsing/parser.mly"
( "try" )
-# 40615 "parsing/parser.ml"
+# 40760 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3608 "parsing/parser.mly"
+# 3635 "parsing/parser.mly"
( "type" )
-# 40640 "parsing/parser.ml"
+# 40785 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3609 "parsing/parser.mly"
+# 3636 "parsing/parser.mly"
( "val" )
-# 40665 "parsing/parser.ml"
+# 40810 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3610 "parsing/parser.mly"
+# 3637 "parsing/parser.mly"
( "virtual" )
-# 40690 "parsing/parser.ml"
+# 40835 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3611 "parsing/parser.mly"
+# 3638 "parsing/parser.mly"
( "when" )
-# 40715 "parsing/parser.ml"
+# 40860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3612 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( "while" )
-# 40740 "parsing/parser.ml"
+# 40885 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3613 "parsing/parser.mly"
+# 3640 "parsing/parser.mly"
( "with" )
-# 40765 "parsing/parser.ml"
+# 40910 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.type_exception * string Asttypes.loc option) =
-# 2914 "parsing/parser.mly"
+# 2937 "parsing/parser.mly"
( _1 )
-# 40790 "parsing/parser.ml"
+# 40935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined5 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 40866 "parsing/parser.ml"
+# 41011 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined5_ in
let attrs2 =
let _1 = _1_inlined4 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 40875 "parsing/parser.ml"
+# 41020 "parsing/parser.ml"
in
let lid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40886 "parsing/parser.ml"
+# 41031 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40897 "parsing/parser.ml"
+# 41042 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 40905 "parsing/parser.ml"
+# 41050 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2923 "parsing/parser.mly"
+# 2946 "parsing/parser.mly"
( let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
(Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 40918 "parsing/parser.ml"
+# 41063 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2438 "parsing/parser.mly"
+# 2461 "parsing/parser.mly"
( _2 )
-# 40950 "parsing/parser.ml"
+# 41095 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2440 "parsing/parser.mly"
+# 2463 "parsing/parser.mly"
( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) )
-# 40985 "parsing/parser.ml"
+# 41130 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _3 =
-# 2341 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( xs )
-# 41038 "parsing/parser.ml"
+# 41183 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2442 "parsing/parser.mly"
+# 2465 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 41046 "parsing/parser.ml"
+# 41191 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 41073 "parsing/parser.ml"
+# 41218 "parsing/parser.ml"
in
let xs =
let items =
-# 840 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( [] )
-# 41079 "parsing/parser.ml"
+# 41224 "parsing/parser.ml"
in
-# 1225 "parsing/parser.mly"
+# 1247 "parsing/parser.mly"
( items )
-# 41084 "parsing/parser.ml"
+# 41229 "parsing/parser.ml"
in
# 267 "menhir/standard.mly"
( xs @ ys )
-# 41090 "parsing/parser.ml"
+# 41235 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 762 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 41099 "parsing/parser.ml"
+# 41244 "parsing/parser.ml"
in
-# 1218 "parsing/parser.mly"
+# 1240 "parsing/parser.mly"
( _1 )
-# 41105 "parsing/parser.ml"
+# 41250 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 41146 "parsing/parser.ml"
+# 41291 "parsing/parser.ml"
in
let xs =
let items =
let _1 =
let _1 =
let attrs =
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 41156 "parsing/parser.ml"
+# 41301 "parsing/parser.ml"
in
-# 1232 "parsing/parser.mly"
+# 1254 "parsing/parser.mly"
( mkstrexp e attrs )
-# 41161 "parsing/parser.ml"
+# 41306 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 774 "parsing/parser.mly"
+# 796 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 41169 "parsing/parser.ml"
+# 41314 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 793 "parsing/parser.mly"
+# 815 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 41179 "parsing/parser.ml"
+# 41324 "parsing/parser.ml"
in
-# 842 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( x )
-# 41185 "parsing/parser.ml"
+# 41330 "parsing/parser.ml"
in
-# 1225 "parsing/parser.mly"
+# 1247 "parsing/parser.mly"
( items )
-# 41191 "parsing/parser.ml"
+# 41336 "parsing/parser.ml"
in
# 267 "menhir/standard.mly"
( xs @ ys )
-# 41197 "parsing/parser.ml"
+# 41342 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 762 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 41206 "parsing/parser.ml"
+# 41351 "parsing/parser.ml"
in
-# 1218 "parsing/parser.mly"
+# 1240 "parsing/parser.mly"
( _1 )
-# 41212 "parsing/parser.ml"
+# 41357 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1247 "parsing/parser.mly"
+# 1269 "parsing/parser.mly"
( val_of_let_bindings ~loc:_sloc _1 )
-# 41240 "parsing/parser.ml"
+# 41385 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 41276 "parsing/parser.ml"
+# 41421 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1250 "parsing/parser.mly"
+# 1272 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
Pstr_extension (_1, add_docs_attrs docs _2) )
-# 41287 "parsing/parser.ml"
+# 41432 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 809 "parsing/parser.mly"
+# 831 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 41297 "parsing/parser.ml"
+# 41442 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41303 "parsing/parser.ml"
+# 41448 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1253 "parsing/parser.mly"
+# 1275 "parsing/parser.mly"
( Pstr_attribute _1 )
-# 41329 "parsing/parser.ml"
+# 41474 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 809 "parsing/parser.mly"
+# 831 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 41337 "parsing/parser.ml"
+# 41482 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41343 "parsing/parser.ml"
+# 41488 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1257 "parsing/parser.mly"
+# 1279 "parsing/parser.mly"
( pstr_primitive _1 )
-# 41369 "parsing/parser.ml"
+# 41514 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41377 "parsing/parser.ml"
+# 41522 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41383 "parsing/parser.ml"
+# 41528 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1259 "parsing/parser.mly"
+# 1281 "parsing/parser.mly"
( pstr_primitive _1 )
-# 41409 "parsing/parser.ml"
+# 41554 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41417 "parsing/parser.ml"
+# 41562 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41423 "parsing/parser.ml"
+# 41568 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 41460 "parsing/parser.ml"
+# 41605 "parsing/parser.ml"
in
-# 2769 "parsing/parser.mly"
+# 2792 "parsing/parser.mly"
( _1 )
-# 41465 "parsing/parser.ml"
+# 41610 "parsing/parser.ml"
in
-# 2752 "parsing/parser.mly"
+# 2775 "parsing/parser.mly"
( _1 )
-# 41471 "parsing/parser.ml"
+# 41616 "parsing/parser.ml"
in
-# 1261 "parsing/parser.mly"
+# 1283 "parsing/parser.mly"
( pstr_type _1 )
-# 41477 "parsing/parser.ml"
+# 41622 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41487 "parsing/parser.ml"
+# 41632 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41493 "parsing/parser.ml"
+# 41638 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 41580 "parsing/parser.ml"
+# 41725 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 993 "parsing/parser.mly"
+# 1015 "parsing/parser.mly"
( List.rev xs )
-# 41587 "parsing/parser.ml"
+# 41732 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41597 "parsing/parser.ml"
+# 41742 "parsing/parser.ml"
in
let _4 =
-# 3485 "parsing/parser.mly"
+# 3512 "parsing/parser.mly"
( Recursive )
-# 41603 "parsing/parser.ml"
+# 41748 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 41610 "parsing/parser.ml"
+# 41755 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3006 "parsing/parser.mly"
+# 3029 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 41622 "parsing/parser.ml"
+# 41767 "parsing/parser.ml"
in
-# 2989 "parsing/parser.mly"
+# 3012 "parsing/parser.mly"
( _1 )
-# 41628 "parsing/parser.ml"
+# 41773 "parsing/parser.ml"
in
-# 1263 "parsing/parser.mly"
+# 1285 "parsing/parser.mly"
( pstr_typext _1 )
-# 41634 "parsing/parser.ml"
+# 41779 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41644 "parsing/parser.ml"
+# 41789 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41650 "parsing/parser.ml"
+# 41795 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 41744 "parsing/parser.ml"
+# 41889 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 993 "parsing/parser.mly"
+# 1015 "parsing/parser.mly"
( List.rev xs )
-# 41751 "parsing/parser.ml"
+# 41896 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41761 "parsing/parser.ml"
+# 41906 "parsing/parser.ml"
in
let _4 =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3486 "parsing/parser.mly"
+# 3513 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 41772 "parsing/parser.ml"
+# 41917 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 41780 "parsing/parser.ml"
+# 41925 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3006 "parsing/parser.mly"
+# 3029 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 41792 "parsing/parser.ml"
+# 41937 "parsing/parser.ml"
in
-# 2989 "parsing/parser.mly"
+# 3012 "parsing/parser.mly"
( _1 )
-# 41798 "parsing/parser.ml"
+# 41943 "parsing/parser.ml"
in
-# 1263 "parsing/parser.mly"
+# 1285 "parsing/parser.mly"
( pstr_typext _1 )
-# 41804 "parsing/parser.ml"
+# 41949 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41814 "parsing/parser.ml"
+# 41959 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41820 "parsing/parser.ml"
+# 41965 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1265 "parsing/parser.mly"
+# 1287 "parsing/parser.mly"
( pstr_exception _1 )
-# 41846 "parsing/parser.ml"
+# 41991 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41854 "parsing/parser.ml"
+# 41999 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41860 "parsing/parser.ml"
+# 42005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.module_expr) = Obj.magic body in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 41913 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 41929 "parsing/parser.ml"
+# 42070 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41941 "parsing/parser.ml"
+# 42082 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 41949 "parsing/parser.ml"
+# 42090 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1291 "parsing/parser.mly"
+# 1313 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
- let body = Mb.mk uid body ~attrs ~loc ~docs in
+ let body = Mb.mk name body ~attrs ~loc ~docs in
Pstr_module body, ext )
-# 41962 "parsing/parser.ml"
+# 42103 "parsing/parser.ml"
in
-# 1267 "parsing/parser.mly"
+# 1289 "parsing/parser.mly"
( _1 )
-# 41968 "parsing/parser.ml"
+# 42109 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 41978 "parsing/parser.ml"
+# 42119 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 41984 "parsing/parser.ml"
+# 42125 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let bs : (Parsetree.module_binding list) = Obj.magic bs in
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.module_expr) = Obj.magic body in
- let _1_inlined2 : (
-# 666 "parsing/parser.mly"
- (string)
-# 42050 "parsing/parser.ml"
- ) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
let _4 : unit = Obj.magic _4 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 42069 "parsing/parser.ml"
+# 42206 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
- let uid =
+ let name =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42081 "parsing/parser.ml"
+# 42218 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 42089 "parsing/parser.ml"
+# 42226 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1326 "parsing/parser.mly"
+# 1347 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs _sloc in
ext,
- Mb.mk uid body ~attrs ~loc ~docs
+ Mb.mk name body ~attrs ~loc ~docs
)
-# 42104 "parsing/parser.ml"
+# 42241 "parsing/parser.ml"
in
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 42110 "parsing/parser.ml"
+# 42247 "parsing/parser.ml"
in
-# 1314 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
( _1 )
-# 42116 "parsing/parser.ml"
+# 42253 "parsing/parser.ml"
in
-# 1269 "parsing/parser.mly"
+# 1291 "parsing/parser.mly"
( pstr_recmodule _1 )
-# 42122 "parsing/parser.ml"
+# 42259 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42132 "parsing/parser.ml"
+# 42269 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 42138 "parsing/parser.ml"
+# 42275 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1271 "parsing/parser.mly"
+# 1293 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_modtype body, ext) )
-# 42164 "parsing/parser.ml"
+# 42301 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42172 "parsing/parser.ml"
+# 42309 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 42178 "parsing/parser.ml"
+# 42315 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1273 "parsing/parser.mly"
+# 1295 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_open body, ext) )
-# 42204 "parsing/parser.ml"
+# 42341 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42212 "parsing/parser.ml"
+# 42349 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 42218 "parsing/parser.ml"
+# 42355 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 42290 "parsing/parser.ml"
+# 42427 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 42310 "parsing/parser.ml"
+# 42447 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42322 "parsing/parser.ml"
+# 42459 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 42330 "parsing/parser.ml"
+# 42467 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1645 "parsing/parser.mly"
+# 1665 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id body ~virt ~params ~attrs ~loc ~docs
)
-# 42345 "parsing/parser.ml"
+# 42482 "parsing/parser.ml"
in
-# 1001 "parsing/parser.mly"
+# 1023 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 42351 "parsing/parser.ml"
+# 42488 "parsing/parser.ml"
in
-# 1634 "parsing/parser.mly"
+# 1654 "parsing/parser.mly"
( _1 )
-# 42357 "parsing/parser.ml"
+# 42494 "parsing/parser.ml"
in
-# 1275 "parsing/parser.mly"
+# 1297 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class l, ext) )
-# 42363 "parsing/parser.ml"
+# 42500 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42373 "parsing/parser.ml"
+# 42510 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 42379 "parsing/parser.ml"
+# 42516 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1277 "parsing/parser.mly"
+# 1299 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class_type l, ext) )
-# 42405 "parsing/parser.ml"
+# 42542 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42413 "parsing/parser.ml"
+# 42550 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 42419 "parsing/parser.ml"
+# 42556 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 42477 "parsing/parser.ml"
+# 42614 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 42486 "parsing/parser.ml"
+# 42623 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1363 "parsing/parser.mly"
+# 1384 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Incl.mk thing ~attrs ~loc ~docs, ext
)
-# 42500 "parsing/parser.ml"
+# 42637 "parsing/parser.ml"
in
-# 1279 "parsing/parser.mly"
+# 1301 "parsing/parser.mly"
( pstr_include _1 )
-# 42506 "parsing/parser.ml"
+# 42643 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 826 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42516 "parsing/parser.ml"
+# 42653 "parsing/parser.ml"
in
-# 1281 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( _1 )
-# 42522 "parsing/parser.ml"
+# 42659 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3548 "parsing/parser.mly"
+# 3575 "parsing/parser.mly"
( "-" )
-# 42547 "parsing/parser.ml"
+# 42684 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3549 "parsing/parser.mly"
+# 3576 "parsing/parser.mly"
( "-." )
-# 42572 "parsing/parser.ml"
+# 42709 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _5 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 42627 "parsing/parser.ml"
+# 42764 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined1_ in
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 42636 "parsing/parser.ml"
+# 42773 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 42641 "parsing/parser.ml"
+# 42778 "parsing/parser.ml"
in
-# 3276 "parsing/parser.mly"
+# 3299 "parsing/parser.mly"
( _1 )
-# 42647 "parsing/parser.ml"
+# 42784 "parsing/parser.ml"
in
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42657 "parsing/parser.ml"
+# 42794 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3262 "parsing/parser.mly"
+# 3285 "parsing/parser.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _5 in
Rf.tag ~loc:(make_loc _sloc) ~attrs _1 _3 _4 )
-# 42668 "parsing/parser.ml"
+# 42805 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 42702 "parsing/parser.ml"
+# 42839 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42713 "parsing/parser.ml"
+# 42850 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3266 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _2 in
Rf.tag ~loc:(make_loc _sloc) ~attrs _1 true [] )
-# 42724 "parsing/parser.ml"
+# 42861 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase) = let arg =
# 124 "menhir/standard.mly"
( None )
-# 42756 "parsing/parser.ml"
+# 42893 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined1_ in
let dir =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42767 "parsing/parser.ml"
+# 42904 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 42776 "parsing/parser.ml"
+# 42913 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (
-# 658 "parsing/parser.mly"
+# 680 "parsing/parser.mly"
(string * string option)
-# 42809 "parsing/parser.ml"
+# 42946 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3452 "parsing/parser.mly"
+# 3479 "parsing/parser.mly"
( let (s, _) = _1 in Pdir_string s )
-# 42822 "parsing/parser.ml"
+# 42959 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 831 "parsing/parser.mly"
+# 853 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 42830 "parsing/parser.ml"
+# 42967 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 42836 "parsing/parser.ml"
+# 42973 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42848 "parsing/parser.ml"
+# 42985 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 42857 "parsing/parser.ml"
+# 42994 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (
-# 606 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string * char option)
-# 42890 "parsing/parser.ml"
+# 43027 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3453 "parsing/parser.mly"
+# 3480 "parsing/parser.mly"
( let (n, m) = _1 in Pdir_int (n ,m) )
-# 42903 "parsing/parser.ml"
+# 43040 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 831 "parsing/parser.mly"
+# 853 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 42911 "parsing/parser.ml"
+# 43048 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 42917 "parsing/parser.ml"
+# 43054 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42929 "parsing/parser.ml"
+# 43066 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 42938 "parsing/parser.ml"
+# 43075 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3454 "parsing/parser.mly"
+# 3481 "parsing/parser.mly"
( Pdir_ident _1 )
-# 42980 "parsing/parser.ml"
+# 43117 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 831 "parsing/parser.mly"
+# 853 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 42988 "parsing/parser.ml"
+# 43125 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 42994 "parsing/parser.ml"
+# 43131 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43006 "parsing/parser.ml"
+# 43143 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43015 "parsing/parser.ml"
+# 43152 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3455 "parsing/parser.mly"
+# 3482 "parsing/parser.mly"
( Pdir_ident _1 )
-# 43057 "parsing/parser.ml"
+# 43194 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 831 "parsing/parser.mly"
+# 853 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43065 "parsing/parser.ml"
+# 43202 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 43071 "parsing/parser.ml"
+# 43208 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43083 "parsing/parser.ml"
+# 43220 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43092 "parsing/parser.ml"
+# 43229 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3456 "parsing/parser.mly"
+# 3483 "parsing/parser.mly"
( Pdir_bool false )
-# 43134 "parsing/parser.ml"
+# 43271 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 831 "parsing/parser.mly"
+# 853 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43142 "parsing/parser.ml"
+# 43279 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 43148 "parsing/parser.ml"
+# 43285 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43160 "parsing/parser.ml"
+# 43297 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43169 "parsing/parser.ml"
+# 43306 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3457 "parsing/parser.mly"
+# 3484 "parsing/parser.mly"
( Pdir_bool true )
-# 43211 "parsing/parser.ml"
+# 43348 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 831 "parsing/parser.mly"
+# 853 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43219 "parsing/parser.ml"
+# 43356 "parsing/parser.ml"
in
# 126 "menhir/standard.mly"
( Some x )
-# 43225 "parsing/parser.ml"
+# 43362 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43237 "parsing/parser.ml"
+# 43374 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3448 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43246 "parsing/parser.ml"
+# 43383 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_e_ in
let _endpos = _endpos__2_ in
let _v : (
-# 750 "parsing/parser.mly"
+# 772 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 43285 "parsing/parser.ml"
+# 43422 "parsing/parser.ml"
) = let _1 =
let _1 =
let _1 =
let attrs =
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 43292 "parsing/parser.ml"
+# 43429 "parsing/parser.ml"
in
-# 1232 "parsing/parser.mly"
+# 1254 "parsing/parser.mly"
( mkstrexp e attrs )
-# 43297 "parsing/parser.ml"
+# 43434 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 774 "parsing/parser.mly"
+# 796 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 43305 "parsing/parser.ml"
+# 43442 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 762 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 43314 "parsing/parser.ml"
+# 43451 "parsing/parser.ml"
in
-# 1039 "parsing/parser.mly"
+# 1061 "parsing/parser.mly"
( Ptop_def _1 )
-# 43320 "parsing/parser.ml"
+# 43457 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xss_ in
let _endpos = _endpos__2_ in
let _v : (
-# 750 "parsing/parser.mly"
+# 772 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 43352 "parsing/parser.ml"
+# 43489 "parsing/parser.ml"
) = let _1 =
let _1 =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 43357 "parsing/parser.ml"
+# 43494 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 762 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 43365 "parsing/parser.ml"
+# 43502 "parsing/parser.ml"
in
-# 1043 "parsing/parser.mly"
+# 1065 "parsing/parser.mly"
( Ptop_def _1 )
-# 43371 "parsing/parser.ml"
+# 43508 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 750 "parsing/parser.mly"
+# 772 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 43403 "parsing/parser.ml"
+# 43540 "parsing/parser.ml"
) =
-# 1047 "parsing/parser.mly"
+# 1069 "parsing/parser.mly"
( _1 )
-# 43407 "parsing/parser.ml"
+# 43544 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (
-# 750 "parsing/parser.mly"
+# 772 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 43432 "parsing/parser.ml"
+# 43569 "parsing/parser.ml"
) =
-# 1050 "parsing/parser.mly"
+# 1072 "parsing/parser.mly"
( raise End_of_file )
-# 43436 "parsing/parser.ml"
+# 43573 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3168 "parsing/parser.mly"
+# 3191 "parsing/parser.mly"
( ty )
-# 43461 "parsing/parser.ml"
+# 43598 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 43489 "parsing/parser.ml"
+# 43626 "parsing/parser.ml"
in
-# 932 "parsing/parser.mly"
+# 954 "parsing/parser.mly"
( xs )
-# 43494 "parsing/parser.ml"
+# 43631 "parsing/parser.ml"
in
-# 3171 "parsing/parser.mly"
+# 3194 "parsing/parser.mly"
( Ptyp_tuple tys )
-# 43500 "parsing/parser.ml"
+# 43637 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 43510 "parsing/parser.ml"
+# 43647 "parsing/parser.ml"
in
-# 3173 "parsing/parser.mly"
+# 3196 "parsing/parser.mly"
( _1 )
-# 43516 "parsing/parser.ml"
+# 43653 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2516 "parsing/parser.mly"
+# 2539 "parsing/parser.mly"
( (Some _2, None) )
-# 43548 "parsing/parser.ml"
+# 43685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2517 "parsing/parser.mly"
+# 2540 "parsing/parser.mly"
( (Some _2, Some _4) )
-# 43594 "parsing/parser.ml"
+# 43731 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2518 "parsing/parser.mly"
+# 2541 "parsing/parser.mly"
( (None, Some _2) )
-# 43626 "parsing/parser.ml"
+# 43763 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2519 "parsing/parser.mly"
+# 2542 "parsing/parser.mly"
( syntax_error() )
-# 43658 "parsing/parser.ml"
+# 43795 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2520 "parsing/parser.mly"
+# 2543 "parsing/parser.mly"
( syntax_error() )
-# 43690 "parsing/parser.ml"
+# 43827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 2843 "parsing/parser.mly"
+# 2866 "parsing/parser.mly"
( (Ptype_abstract, Public, None) )
-# 43708 "parsing/parser.ml"
+# 43845 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 2845 "parsing/parser.mly"
+# 2868 "parsing/parser.mly"
( _2 )
-# 43740 "parsing/parser.ml"
+# 43877 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 43761 "parsing/parser.ml"
+# 43898 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3415 "parsing/parser.mly"
+# 3442 "parsing/parser.mly"
( Lident _1 )
-# 43769 "parsing/parser.ml"
+# 43906 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 43802 "parsing/parser.ml"
+# 43939 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3416 "parsing/parser.mly"
+# 3443 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 43812 "parsing/parser.ml"
+# 43949 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type * Asttypes.variance) =
-# 2860 "parsing/parser.mly"
+# 2883 "parsing/parser.mly"
( _2, _1 )
-# 43844 "parsing/parser.ml"
+# 43981 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * Asttypes.variance) list) =
-# 2853 "parsing/parser.mly"
+# 2876 "parsing/parser.mly"
( [] )
-# 43862 "parsing/parser.ml"
+# 43999 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_p_ in
let _endpos = _endpos_p_ in
let _v : ((Parsetree.core_type * Asttypes.variance) list) =
-# 2855 "parsing/parser.mly"
+# 2878 "parsing/parser.mly"
( [p] )
-# 43887 "parsing/parser.ml"
+# 44024 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 43927 "parsing/parser.ml"
+# 44064 "parsing/parser.ml"
in
-# 904 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( xs )
-# 43932 "parsing/parser.ml"
+# 44069 "parsing/parser.ml"
in
-# 2857 "parsing/parser.mly"
+# 2880 "parsing/parser.mly"
( ps )
-# 43938 "parsing/parser.ml"
+# 44075 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2865 "parsing/parser.mly"
+# 2888 "parsing/parser.mly"
( Ptyp_var tyvar )
-# 43971 "parsing/parser.ml"
+# 44108 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_tyvar_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 43980 "parsing/parser.ml"
+# 44117 "parsing/parser.ml"
in
-# 2868 "parsing/parser.mly"
+# 2891 "parsing/parser.mly"
( _1 )
-# 43986 "parsing/parser.ml"
+# 44123 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2867 "parsing/parser.mly"
+# 2890 "parsing/parser.mly"
( Ptyp_any )
-# 44012 "parsing/parser.ml"
+# 44149 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 807 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 44020 "parsing/parser.ml"
+# 44157 "parsing/parser.ml"
in
-# 2868 "parsing/parser.mly"
+# 2891 "parsing/parser.mly"
( _1 )
-# 44026 "parsing/parser.ml"
+# 44163 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.variance) =
-# 2872 "parsing/parser.mly"
+# 2895 "parsing/parser.mly"
( Invariant )
-# 44044 "parsing/parser.ml"
+# 44181 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance) =
-# 2873 "parsing/parser.mly"
+# 2896 "parsing/parser.mly"
( Covariant )
-# 44069 "parsing/parser.ml"
+# 44206 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance) =
-# 2874 "parsing/parser.mly"
+# 2897 "parsing/parser.mly"
( Contravariant )
-# 44094 "parsing/parser.ml"
+# 44231 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xss_ in
let _endpos = _endpos__2_ in
let _v : (
-# 752 "parsing/parser.mly"
+# 774 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 44126 "parsing/parser.ml"
+# 44263 "parsing/parser.ml"
) = let _1 =
let _1 =
let ys =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 44132 "parsing/parser.ml"
+# 44269 "parsing/parser.ml"
in
let xs =
let _1 =
-# 840 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( [] )
-# 44138 "parsing/parser.ml"
+# 44275 "parsing/parser.ml"
in
-# 1070 "parsing/parser.mly"
+# 1092 "parsing/parser.mly"
( _1 )
-# 44143 "parsing/parser.ml"
+# 44280 "parsing/parser.ml"
in
# 267 "menhir/standard.mly"
( xs @ ys )
-# 44149 "parsing/parser.ml"
+# 44286 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 766 "parsing/parser.mly"
+# 788 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 44158 "parsing/parser.ml"
+# 44295 "parsing/parser.ml"
in
-# 1063 "parsing/parser.mly"
+# 1085 "parsing/parser.mly"
( _1 )
-# 44164 "parsing/parser.ml"
+# 44301 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_e_ in
let _endpos = _endpos__2_ in
let _v : (
-# 752 "parsing/parser.mly"
+# 774 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 44210 "parsing/parser.ml"
+# 44347 "parsing/parser.ml"
) = let _1 =
let _1 =
let ys =
# 260 "menhir/standard.mly"
( List.flatten xss )
-# 44216 "parsing/parser.ml"
+# 44353 "parsing/parser.ml"
in
let xs =
let _1 =
let _1 =
let _1 =
let attrs =
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 44226 "parsing/parser.ml"
+# 44363 "parsing/parser.ml"
in
-# 1232 "parsing/parser.mly"
+# 1254 "parsing/parser.mly"
( mkstrexp e attrs )
-# 44231 "parsing/parser.ml"
+# 44368 "parsing/parser.ml"
in
-# 784 "parsing/parser.mly"
+# 806 "parsing/parser.mly"
( Ptop_def [_1] )
-# 44237 "parsing/parser.ml"
+# 44374 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 782 "parsing/parser.mly"
+# 804 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 44245 "parsing/parser.ml"
+# 44382 "parsing/parser.ml"
in
-# 842 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( x )
-# 44251 "parsing/parser.ml"
+# 44388 "parsing/parser.ml"
in
-# 1070 "parsing/parser.mly"
+# 1092 "parsing/parser.mly"
( _1 )
-# 44257 "parsing/parser.ml"
+# 44394 "parsing/parser.ml"
in
# 267 "menhir/standard.mly"
( xs @ ys )
-# 44263 "parsing/parser.ml"
+# 44400 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 766 "parsing/parser.mly"
+# 788 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 44272 "parsing/parser.ml"
+# 44409 "parsing/parser.ml"
in
-# 1063 "parsing/parser.mly"
+# 1085 "parsing/parser.mly"
( _1 )
-# 44278 "parsing/parser.ml"
+# 44415 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 44299 "parsing/parser.ml"
+# 44436 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3346 "parsing/parser.mly"
+# 3369 "parsing/parser.mly"
( _1 )
-# 44307 "parsing/parser.ml"
+# 44444 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) =
-# 3347 "parsing/parser.mly"
+# 3370 "parsing/parser.mly"
( _2 )
-# 44346 "parsing/parser.ml"
+# 44483 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (string) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3348 "parsing/parser.mly"
+# 3371 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 44387 "parsing/parser.ml"
+# 44524 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (string) = let _loc__2_ = (_startpos__2_, _endpos__2_) in
-# 3349 "parsing/parser.mly"
+# 3372 "parsing/parser.mly"
( expecting _loc__2_ "operator" )
-# 44420 "parsing/parser.ml"
+# 44557 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (string) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3350 "parsing/parser.mly"
+# 3373 "parsing/parser.mly"
( expecting _loc__3_ "module-expr" )
-# 44460 "parsing/parser.ml"
+# 44597 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3398 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( Lident _1 )
-# 44485 "parsing/parser.ml"
+# 44622 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3399 "parsing/parser.mly"
+# 3426 "parsing/parser.mly"
( Ldot(_1, _3) )
-# 44524 "parsing/parser.ml"
+# 44661 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty : (Parsetree.core_type) = Obj.magic ty in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 44571 "parsing/parser.ml"
+# 44708 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let mutable_ : (Asttypes.mutable_flag) = Obj.magic mutable_ in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 44585 "parsing/parser.ml"
+# 44722 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44593 "parsing/parser.ml"
+# 44730 "parsing/parser.ml"
in
let attrs =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 44599 "parsing/parser.ml"
+# 44736 "parsing/parser.ml"
in
let _1 =
-# 3541 "parsing/parser.mly"
+# 3568 "parsing/parser.mly"
( Fresh )
-# 44604 "parsing/parser.ml"
+# 44741 "parsing/parser.ml"
in
-# 1785 "parsing/parser.mly"
+# 1805 "parsing/parser.mly"
( (label, mutable_, Cfk_virtual ty), attrs )
-# 44609 "parsing/parser.ml"
+# 44746 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 44656 "parsing/parser.ml"
+# 44793 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 44670 "parsing/parser.ml"
+# 44807 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44678 "parsing/parser.ml"
+# 44815 "parsing/parser.ml"
in
let _2 =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 44684 "parsing/parser.ml"
+# 44821 "parsing/parser.ml"
in
let _1 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 44689 "parsing/parser.ml"
+# 44826 "parsing/parser.ml"
in
-# 1787 "parsing/parser.mly"
+# 1807 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 44694 "parsing/parser.ml"
+# 44831 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 44747 "parsing/parser.ml"
+# 44884 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 44762 "parsing/parser.ml"
+# 44899 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44770 "parsing/parser.ml"
+# 44907 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 44778 "parsing/parser.ml"
+# 44915 "parsing/parser.ml"
in
let _1 =
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 44784 "parsing/parser.ml"
+# 44921 "parsing/parser.ml"
in
-# 1787 "parsing/parser.mly"
+# 1807 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 44789 "parsing/parser.ml"
+# 44926 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
let _1_inlined1 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 44843 "parsing/parser.ml"
+# 44980 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 44857 "parsing/parser.ml"
+# 44994 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44865 "parsing/parser.ml"
+# 45002 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 44872 "parsing/parser.ml"
+# 45009 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3544 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
( Fresh )
-# 44878 "parsing/parser.ml"
+# 45015 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__7_ in
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1790 "parsing/parser.mly"
+# 1810 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 44898 "parsing/parser.ml"
+# 45035 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
let _1_inlined2 : (
-# 620 "parsing/parser.mly"
+# 642 "parsing/parser.mly"
(string)
-# 44958 "parsing/parser.ml"
+# 45095 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3320 "parsing/parser.mly"
+# 3343 "parsing/parser.mly"
( _1 )
-# 44973 "parsing/parser.ml"
+# 45110 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44981 "parsing/parser.ml"
+# 45118 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 44990 "parsing/parser.ml"
+# 45127 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3545 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
( Override )
-# 44997 "parsing/parser.ml"
+# 45134 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1790 "parsing/parser.mly"
+# 1810 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 45016 "parsing/parser.ml"
+# 45153 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3638 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _1 )
-# 45085 "parsing/parser.ml"
+# 45222 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45097 "parsing/parser.ml"
+# 45234 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3642 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 45105 "parsing/parser.ml"
+# 45242 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2714 "parsing/parser.mly"
+# 2737 "parsing/parser.mly"
( let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Val.mk id ty ~attrs ~loc ~docs,
ext )
-# 45118 "parsing/parser.ml"
+# 45255 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.virtual_flag) =
-# 3505 "parsing/parser.mly"
+# 3532 "parsing/parser.mly"
( Concrete )
-# 45136 "parsing/parser.ml"
+# 45273 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.virtual_flag) =
-# 3506 "parsing/parser.mly"
+# 3533 "parsing/parser.mly"
( Virtual )
-# 45161 "parsing/parser.ml"
+# 45298 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3529 "parsing/parser.mly"
+# 3556 "parsing/parser.mly"
( Immutable )
-# 45186 "parsing/parser.ml"
+# 45323 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3530 "parsing/parser.mly"
+# 3557 "parsing/parser.mly"
( Mutable )
-# 45218 "parsing/parser.ml"
+# 45355 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3531 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( Mutable )
-# 45250 "parsing/parser.ml"
+# 45387 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3536 "parsing/parser.mly"
+# 3563 "parsing/parser.mly"
( Public )
-# 45275 "parsing/parser.ml"
+# 45412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3537 "parsing/parser.mly"
+# 3564 "parsing/parser.mly"
( Private )
-# 45307 "parsing/parser.ml"
+# 45444 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3538 "parsing/parser.mly"
+# 3565 "parsing/parser.mly"
( Private )
-# 45339 "parsing/parser.ml"
+# 45476 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "menhir/standard.mly"
( List.rev xs )
-# 45401 "parsing/parser.ml"
+# 45538 "parsing/parser.ml"
in
-# 854 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( xs )
-# 45406 "parsing/parser.ml"
+# 45543 "parsing/parser.ml"
in
-# 2814 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 45412 "parsing/parser.ml"
+# 45549 "parsing/parser.ml"
in
let _endpos__6_ = _endpos_xs_ in
let _5 =
let _1 = _1_inlined2 in
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 45421 "parsing/parser.ml"
+# 45558 "parsing/parser.ml"
in
let _3 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45432 "parsing/parser.ml"
+# 45569 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3039 "parsing/parser.mly"
+# 3062 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_type
(_3,
~manifest:_5
~priv:_4
~loc:(make_loc _sloc))) )
-# 45449 "parsing/parser.ml"
+# 45586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.with_constraint) = let _5 =
let _1 = _1_inlined2 in
-# 3116 "parsing/parser.mly"
+# 3139 "parsing/parser.mly"
( _1 )
-# 45504 "parsing/parser.ml"
+# 45641 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45516 "parsing/parser.ml"
+# 45653 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3052 "parsing/parser.mly"
+# 3075 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_typesubst
(_3,
~params:_2
~manifest:_5
~loc:(make_loc _sloc))) )
-# 45531 "parsing/parser.ml"
+# 45668 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45582 "parsing/parser.ml"
+# 45719 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45593 "parsing/parser.ml"
+# 45730 "parsing/parser.ml"
in
-# 3060 "parsing/parser.mly"
+# 3083 "parsing/parser.mly"
( Pwith_module (_2, _4) )
-# 45599 "parsing/parser.ml"
+# 45736 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45650 "parsing/parser.ml"
+# 45787 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 770 "parsing/parser.mly"
+# 792 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45661 "parsing/parser.ml"
+# 45798 "parsing/parser.ml"
in
-# 3062 "parsing/parser.mly"
+# 3085 "parsing/parser.mly"
( Pwith_modsubst (_2, _4) )
-# 45667 "parsing/parser.ml"
+# 45804 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3065 "parsing/parser.mly"
+# 3088 "parsing/parser.mly"
( Public )
-# 45692 "parsing/parser.ml"
+# 45829 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3066 "parsing/parser.mly"
+# 3089 "parsing/parser.mly"
( Private )
-# 45724 "parsing/parser.ml"
+# 45861 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let use_file =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1758 lexer lexbuf) : (
-# 752 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1765 lexer lexbuf) : (
+# 774 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 45755 "parsing/parser.ml"
+# 45892 "parsing/parser.ml"
))
and toplevel_phrase =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1737 lexer lexbuf) : (
-# 750 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1744 lexer lexbuf) : (
+# 772 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 45763 "parsing/parser.ml"
+# 45900 "parsing/parser.ml"
))
and parse_pattern =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1733 lexer lexbuf) : (
-# 758 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1740 lexer lexbuf) : (
+# 780 "parsing/parser.mly"
(Parsetree.pattern)
-# 45771 "parsing/parser.ml"
+# 45908 "parsing/parser.ml"
))
and parse_expression =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1729 lexer lexbuf) : (
-# 756 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1736 lexer lexbuf) : (
+# 778 "parsing/parser.mly"
(Parsetree.expression)
-# 45779 "parsing/parser.ml"
+# 45916 "parsing/parser.ml"
))
and parse_core_type =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1725 lexer lexbuf) : (
-# 754 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1732 lexer lexbuf) : (
+# 776 "parsing/parser.mly"
(Parsetree.core_type)
-# 45787 "parsing/parser.ml"
+# 45924 "parsing/parser.ml"
))
and interface =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1721 lexer lexbuf) : (
-# 748 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1728 lexer lexbuf) : (
+# 770 "parsing/parser.mly"
(Parsetree.signature)
-# 45795 "parsing/parser.ml"
+# 45932 "parsing/parser.ml"
))
and implementation =
fun lexer lexbuf ->
(Obj.magic (MenhirInterpreter.entry 0 lexer lexbuf) : (
-# 746 "parsing/parser.mly"
+# 768 "parsing/parser.mly"
(Parsetree.structure)
-# 45803 "parsing/parser.ml"
+# 45940 "parsing/parser.ml"
))
module Incremental = struct
let use_file =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1758 initial_position) : (
-# 752 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1765 initial_position) : (
+# 774 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 45813 "parsing/parser.ml"
+# 45950 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and toplevel_phrase =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1737 initial_position) : (
-# 750 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1744 initial_position) : (
+# 772 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 45821 "parsing/parser.ml"
+# 45958 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_pattern =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1733 initial_position) : (
-# 758 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1740 initial_position) : (
+# 780 "parsing/parser.mly"
(Parsetree.pattern)
-# 45829 "parsing/parser.ml"
+# 45966 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_expression =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1729 initial_position) : (
-# 756 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1736 initial_position) : (
+# 778 "parsing/parser.mly"
(Parsetree.expression)
-# 45837 "parsing/parser.ml"
+# 45974 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_core_type =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1725 initial_position) : (
-# 754 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1732 initial_position) : (
+# 776 "parsing/parser.mly"
(Parsetree.core_type)
-# 45845 "parsing/parser.ml"
+# 45982 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and interface =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1721 initial_position) : (
-# 748 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1728 initial_position) : (
+# 770 "parsing/parser.mly"
(Parsetree.signature)
-# 45853 "parsing/parser.ml"
+# 45990 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and implementation =
fun initial_position ->
(Obj.magic (MenhirInterpreter.start 0 initial_position) : (
-# 746 "parsing/parser.mly"
+# 768 "parsing/parser.mly"
(Parsetree.structure)
-# 45861 "parsing/parser.ml"
+# 45998 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
end
-# 3668 "parsing/parser.mly"
+# 3695 "parsing/parser.mly"
-# 45869 "parsing/parser.ml"
+# 46006 "parsing/parser.ml"
# 269 "menhir/standard.mly"
-# 45874 "parsing/parser.ml"
+# 46011 "parsing/parser.ml"
(* The path to the bytecode interpreter (in use_runtime mode) *)
if String.length !Clflags.use_runtime > 0 && !Clflags.with_runtime then
begin
- output_string outchan (make_absolute !Clflags.use_runtime);
+ let runtime = make_absolute !Clflags.use_runtime in
+ let runtime =
+ (* shebang mustn't exceed 128 including the #! and \0 *)
+ if String.length runtime > 125 then
+ "/bin/sh\n\
+ exec \"" ^ runtime ^ "\" \"$0\" \"$@\""
+ else
+ runtime
+ in
+ output_string outchan runtime;
output_char outchan '\n';
Bytesections.record outchan "RNTM"
end;
(* Output a bytecode executable as a C file *)
-let link_bytecode_as_c tolink outfile =
+let link_bytecode_as_c tolink outfile with_main =
let outchan = open_out outfile in
Misc.try_finally
~always:(fun () -> close_out outchan)
(* The table of primitives *)
Symtable.output_primitive_table outchan;
(* The entry point *)
- output_string outchan "\
+ if with_main then begin
+ output_string outchan "\
+\n#ifdef _WIN32\
+\nint wmain(int argc, wchar_t **argv)\
+\n#else\
+\nint main(int argc, char **argv)\
+\n#endif\
+\n{\
+\n caml_startup_code(caml_code, sizeof(caml_code),\
+\n caml_data, sizeof(caml_data),\
+\n caml_sections, sizeof(caml_sections),\
+\n /* pooling */ 0,\
+\n argv);\
+\n return 0; /* not reached */\
+\n}\n"
+ end else begin
+ output_string outchan "\
\nvoid caml_startup(char_os ** argv)\
\n{\
\n caml_startup_code(caml_code, sizeof(caml_code),\
\n caml_sections, sizeof(caml_sections),\
\n /* pooling */ 1,\
\n argv);\
-\n}\
+\n}\n"
+ end;
+ output_string outchan "\
\n#ifdef __cplusplus\
\n}\
\n#endif\n";
append_bytecode bytecode_name exec_name
)
end else begin
- let basename = Filename.chop_extension output_name in
+ let basename = Filename.remove_extension output_name in
let c_file, stable_name =
if !Clflags.output_complete_object
&& not (Filename.check_suffix output_name ".c")
Misc.try_finally
~always:(fun () -> List.iter remove_file !temps)
(fun () ->
- link_bytecode_as_c tolink c_file;
- if not (Filename.check_suffix output_name ".c") then begin
+ link_bytecode_as_c tolink c_file !Clflags.output_complete_executable;
+ if !Clflags.output_complete_executable then begin
+ temps := c_file :: !temps;
+ if not (build_custom_runtime c_file output_name) then
+ raise(Error Custom_runtime)
+ end else if not (Filename.check_suffix output_name ".c") then begin
temps := c_file :: !temps;
if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then
raise(Error Custom_runtime);
#! /bin/sh
+
+if test -e '.git' ; then :
+ if test -z "$ac_read_git_config" ; then :
+ extra_args=$(git config ocaml.configure 2>/dev/null)
+ extended_cache=$(git config ocaml.configure-cache 2>/dev/null)
+ cache_file=
+
+ # If ocaml.configure-cache is set, parse the command-line for the --host
+ # option, in order to determine the name of the cache file.
+ if test -n "$extended_cache" ; then :
+ echo "Detected Git configuration option ocaml.configure-cache set to \
+\"$extended_cache\""
+ dashdash=
+ prev=
+ host=default
+ # The logic here is pretty borrowed from autoconf's
+ for option in $extra_args "$@"
+ do
+ if test -n "$prev" ; then :
+ host=$option
+ continue
+ fi
+
+ case $dashdash$option in
+ --)
+ dashdash=yes ;;
+ -host | --host | --hos | --ho)
+ prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ case $option in
+ *=?*) host=$(expr "X$option" : '[^=]*=\(.*\)') ;;
+ *=) host= ;;
+ esac ;;
+ esac
+ done
+ cache_file="`dirname "$0"`/$extended_cache/ocaml-$host.cache"
+ fi
+
+ # If either option has a value, re-invoke configure
+ if test -n "$extra_args$cache_file" ; then :
+ echo "Detected Git configuration option ocaml.configure set to \
+\"$extra_args\""
+ # Too much effort to get the echo to show appropriate quoting - the
+ # invocation itself intentionally quotes $0 and passes $@ exactly as given
+ # but allows a single expansion of ocaml.configure
+ if test -n "$cache_file" ; then :
+ echo "Re-running $0 $extra_args --cache-file \"$cache_file\" $@"
+ ac_read_git_config=true exec "$0" $extra_args \
+ --cache-file "$cache_file" "$@"
+ else
+ echo "Re-running $0 $extra_args $@"
+ ac_read_git_config=true exec "$0" $extra_args "$@"
+ fi
+ fi
+ fi
+fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for OCaml 4.09.1+dev1-2020-03-13.
+# Generated by GNU Autoconf 2.69 for OCaml 4.10.0.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='4.09.1+dev1-2020-03-13'
-PACKAGE_STRING='OCaml 4.09.1+dev1-2020-03-13'
+PACKAGE_VERSION='4.10.0'
+PACKAGE_STRING='OCaml 4.10.0'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
build_vendor
build_cpu
build
+stdlib_manpages
PACKLD
flexlink_flags
flexdll_chain
default_safe_string
force_safe_string
afl
+function_sections
flat_float_array
windows_unicode
max_testsuite_dir_retries
RANLIBCMD
RANLIB
AR
-hashbangscripts
+shebangscripts
+long_shebang
iflexdir
ocamlopt_cppflags
ocamlopt_cflags
DIRECT_CPP
CC
VERSION
+native_compiler
CONFIGURE_ARGS
target_alias
host_alias
enable_flambda_invariants
with_target_bindir
enable_reserved_header_bits
+enable_stdlib_manpages
enable_force_safe_string
enable_flat_float_array
+enable_function_sections
with_afl
enable_shared
enable_static
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OCaml 4.09.1+dev1-2020-03-13 to adapt to many kinds of systems.
+\`configure' configures OCaml 4.10.0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OCaml 4.09.1+dev1-2020-03-13:";;
+ short | recursive ) echo "Configuration of OCaml 4.10.0:";;
esac
cat <<\_ACEOF
--enable-reserved-header-bits=BITS
reserve BITS (between 0 and 31) bits in block
headers for profiling info
- --enable-force-safe-string
- force strings to be safe
+ --disable-stdlib-manpages
+ do not build or install the library man pages
+ --disable-force-safe-string
+ do not force strings to be safe
--disable-flat-float-array
do not use flat float arrays
+ --disable-function-sections
+ do not emit each function in a separate section
--enable-shared[=PKGS] build shared libraries [default=yes]
--enable-static[=PKGS] build static libraries [default=yes]
--enable-fast-install[=PKGS]
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 4.09.1+dev1-2020-03-13
+OCaml configure 4.10.0
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OCaml $as_me 4.09.1+dev1-2020-03-13, which was
+It was created by OCaml $as_me 4.10.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
-{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.09.1+dev1-2020-03-13" >&5
-$as_echo "$as_me: Configuring OCaml version 4.09.1+dev1-2020-03-13" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.10.0" >&5
+$as_echo "$as_me: Configuring OCaml version 4.10.0" >&6;}
# Configuration variables
## Output variables
-VERSION=4.09.1+dev1-2020-03-13
+
+VERSION=4.10.0
# Note: This is present for the flexdll bootstrap where it exposed as the old
+
# TODO: rename this variable
+
+
S=asm
SO=dll
outputexe=-Fe
- mkexedebugflag=''
syslib='$(1).lib' ;; #(
*) :
ccomptype=cc
fi
+# Check whether --enable-stdlib-manpages was given.
+if test "${enable_stdlib_manpages+set}" = set; then :
+ enableval=$enable_stdlib_manpages;
+fi
+
+
# There are two configure-time string safety options,
# explicitly passed.
#
# The configure-time behavior of OCaml 4.05 and older was equivalent
-# to --disable-force-safe-string DEFAULT_STRING=unsafe. OCaml 4.06
-# and later use --disable-force-safe-string DEFAULT_STRING=safe. We
-# expect --enable-force-safe-string to become the default in the future.
+# to --disable-force-safe-string DEFAULT_STRING=unsafe. With OCaml 4.06
+# and older was equivalent to --disable-force-safe-string DEFAULT_STRING=safe.
+# With OCaml 4.10 and later use --enable-force-safe-string DEFAULT_STRING=safe.
+# We expect the --disable-force-safe-string and DEFAULT_STRING=unsafe options
+# to be removed in the future.
# Check whether --enable-force-safe-string was given.
if test "${enable_force_safe_string+set}" = set; then :
fi
+# Check whether --enable-function-sections was given.
+if test "${enable_function_sections+set}" = set; then :
+ enableval=$enable_function_sections;
+else
+ enable_function_sections=auto
+fi
+
+
# Check whether --with-afl was given.
if test "${with_afl+set}" = set; then :
;;
esac
+## Find vendor of the C compiler
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking C compiler vendor" >&5
+$as_echo_n "checking C compiler vendor... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#if defined(_MSC_VER)
+msvc _MSC_VER
+#elif defined(__INTEL_COMPILER)
+icc __INTEL_COMPILER
+#elif defined(__clang_major__) && defined(__clang_minor__)
+clang __clang_major__ __clang_minor__
+#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
+gcc __GNUC__ __GNUC_MINOR__
+#elif defined(__xlc__) && defined(__xlC__)
+xlc __xlC__ __xlC_ver__
+#else
+unknown
+#endif
+
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ if ${ocaml_cv_cc_vendor+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-'`
+fi
+
+else
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "unexpected preprocessor failure
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_cc_vendor" >&5
+$as_echo "$ocaml_cv_cc_vendor" >&6; }
+
+
# Determine how to call the C preprocessor directly.
# Most of the time, calling the C preprocessor through the C compiler is
# desirable and even important.
# We thus figure out how to invoke the C preprocessor directly but
# let the CPP variable untouched, except for the MSVC port where we set it
# manually to make sure the backward compatibility is preserved
-case $host in #(
- *-pc-windows) :
+case $ocaml_cv_cc_vendor in #(
+ xlc-*) :
+ CPP="$CC -E -qnoppline" ;; #(
+ # suppress incompatible XLC line directives
+ msvc-*) :
CPP="$CC -nologo -EP" ;; #(
*) :
;;
interpval=$ac_cv_sys_interpreter
+long_shebang=false
if test "x$interpval" = "xyes"; then :
case $host in #(
*-cygwin|*-*-mingw32|*-pc-windows) :
- hashbangscripts=false ;; #(
+ shebangscripts=false ;; #(
*) :
- hashbangscripts=true
+ shebangscripts=true
+ prev_exec_prefix="$exec_prefix"
+ if test "x$exec_prefix" = "xNONE"; then :
+ exec_prefix="$prefix"
+fi
+ eval "expanded_bindir=\"$bindir\""
+ exec_prefix="$prev_exec_prefix"
+ # Assume maximum shebang is 128 chars; less #!, /ocamlrun, an optional
+ # 1 char suffix and the \0 leaving 115 characters
+ if test "${#expanded_bindir}" -gt 115; then :
+ long_shebang=true
+fi
+
;;
esac
else
- hashbangscripts=false
+ shebangscripts=false
fi
## Check for C99 support: done by libtool
## AC_PROG_CC_C99
-## Find vendor of the C compiler
-
-
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking C compiler vendor" >&5
-$as_echo_n "checking C compiler vendor... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-#if defined(_MSC_VER)
-msvc _MSC_VER
-#elif defined(__INTEL_COMPILER)
-icc __INTEL_COMPILER
-#elif defined(__clang_major__) && defined(__clang_minor__)
-clang __clang_major__ __clang_minor__
-#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
-gcc __GNUC__ __GNUC_MINOR__
-#elif defined(__xlc__) && defined(__xlC__)
-xlc __xlC__ __xlC_ver__
-#else
-unknown
-#endif
-
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- if ${ocaml_cv_cc_vendor+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-'`
-fi
-
-else
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error $? "unexpected preprocessor failure
-See \`config.log' for more details" "$LINENO" 5; }
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_cc_vendor" >&5
-$as_echo "$ocaml_cv_cc_vendor" >&6; }
-
-
## Determine which flags to use for the C compiler
case $ocaml_cv_cc_vendor in #(
outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i" ;; #(
# all warnings enabled
msvc-*) :
- outputobj=-Fo; CPP="cl -nologo -EP"; gcc_warnings="" ;; #(
+ outputobj=-Fo; gcc_warnings="" ;; #(
*) :
- outputobj='-o $(EMPTY)'; case 4.09.1+dev1-2020-03-13 in #(
+ outputobj='-o $(EMPTY)'; case 4.10.0 in #(
*+dev*) :
gcc_warnings="-Wall -Werror" ;; #(
*) :
flexdir='$(ROOTDIR)/flexdll'
fi
iflexdir="-I\"$flexdir\""
- mkexedebugflag="-link -g"
+ mkexedebugflag=''
fi ;; #(
*,x86_64-*-linux*) :
$as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
;;
esac
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((aligned(n)))" >&5
+$as_echo_n "checking whether the C compiler supports __attribute__((aligned(n)))... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+typedef struct {__attribute__((aligned(8))) int t;} t;
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ $as_echo "#define SUPPORTS_ALIGNED_ATTRIBUTE 1" >>confdefs.h
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
# Configure the native-code compiler
arch=none
fi
-CPP_FLAGS="$saved_CPPFLAGS"
+CPPFLAGS="$saved_CPPFLAGS"
## issetugid
fi
+## ffs or _BitScanForward
+
+ac_fn_c_check_func "$LINENO" "ffs" "ac_cv_func_ffs"
+if test "x$ac_cv_func_ffs" = xyes; then :
+ $as_echo "#define HAS_FFS 1" >>confdefs.h
+
+fi
+
+ac_fn_c_check_func "$LINENO" "_BitScanForward" "ac_cv_func__BitScanForward"
+if test "x$ac_cv_func__BitScanForward" = xyes; then :
+ $as_echo "#define HAS_BITSCANFORWARD 1" >>confdefs.h
+
+fi
+
+
## Determine whether the debugger should/can be built
case $enable_debugger in #(
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd -ldl $LIBS"
+LIBS="-lbfd $DLLIBS $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd -ldl"
+ bfd_ldlibs="-lbfd $DLLIBS"
fi
fi
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd -ldl -liberty $LIBS"
+LIBS="-lbfd $DLLIBS -liberty $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd -ldl -liberty"
+ bfd_ldlibs="-lbfd $DLLIBS -liberty"
fi
fi
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd -ldl -liberty -lz $LIBS"
+LIBS="-lbfd $DLLIBS -liberty -lz $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd -ldl -liberty -lz"
+ bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"
fi
fi
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd -ldl -liberty -lz -lintl $LIBS"
+LIBS="-lbfd $DLLIBS -liberty -lz -lintl $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd -ldl -liberty -lz -lintl"
+ bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"
fi
fi
flat_float_array=true
fi
+if test x"$enable_function_sections" = "xno"; then :
+ function_sections=false
+else
+ case $arch in #(
+ amd64|i386|arm64) :
+ # not supported on arm32, see issue #9124.
+ case $target in #(
+ *-cygwin*|*-mingw*|*-windows|*-apple-darwin*) :
+ function_sections=false;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: No support for function sections on $target." >&5
+$as_echo "$as_me: No support for function sections on $target." >&6;} ;; #(
+ *) :
+ case $ocaml_cv_cc_vendor in #(
+ gcc-0123-*|gcc-4-01234567) :
+ function_sections=false;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not
+ supported in GCC prior to version 4.8." >&5
+$as_echo "$as_me: Function sections are not
+ supported in GCC prior to version 4.8." >&6;} ;; #(
+ clang-012-*|clang-3-01234) :
+ function_sections=false;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not supported
+ in Clang prior to version 3.5." >&5
+$as_echo "$as_me: Function sections are not supported
+ in Clang prior to version 3.5." >&6;} ;; #(
+ gcc-*|clang-*) :
+ function_sections=true;
+ internal_cflags="$internal_cflags -ffunction-sections";
+ $as_echo "#define FUNCTION_SECTIONS 1" >>confdefs.h
+ ;; #(
+ *) :
+ function_sections=false;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not supported by
+ $ocaml_cv_cc_vendor." >&5
+$as_echo "$as_me: Function sections are not supported by
+ $ocaml_cv_cc_vendor." >&6;} ;; #(
+ *) :
+ ;;
+esac ;; #(
+ *) :
+ ;;
+esac ;; #(
+ *) :
+ function_sections=false ;;
+esac;
+ if test x"$function_sections" = "xfalse"; then :
+ if test x"$enable_function_sections" = "xyes"; then :
+ as_fn_error $? "Function sections are not supported." "$LINENO" 5
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: Disabling function sections." >&5
+$as_echo "$as_me: Disabling function sections." >&6;}
+fi
+fi
+fi
+
if test x"$with_afl" = "xyes"; then :
afl=true
else
afl=false
fi
-if test x"$enable_force_safe_string" = "xyes"; then :
+if test x"$enable_force_safe_string" = "xno"; then :
+ force_safe_string=false
+else
$as_echo "#define CAML_SAFE_STRING 1" >>confdefs.h
- force_safe_string=true
-else
- force_safe_string=false
+ force_safe_string=true
fi
if test x"$DEFAULT_STRING" = "xunsafe"; then :
*) :
;;
esac
+else
+ if test x"$unix_or_win32" = "xwin32" \
+ && test "$host_vendor-$host_os" != "$build_vendor-$build_os" ; then :
+ case $build in #(
+ *-pc-cygwin) :
+ prefix=`cygpath -m "$prefix"` ;; #(
+ *) :
+ ;;
+esac
+fi
fi
# Define a few macros that were defined in config/m-nt.h
;;
esac
+if test x"$enable_stdlib_manpages" != "xno"; then :
+ stdlib_manpages=true
+else
+ stdlib_manpages=false
+fi
+
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OCaml $as_me 4.09.1+dev1-2020-03-13, which was
+This file was extended by OCaml $as_me 4.10.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-OCaml config.status 4.09.1+dev1-2020-03-13
+OCaml config.status 4.10.0
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
# Process this file with autoconf to produce a configure script.
+# Require Autoconf 2.69 for repeatability in CI
+AC_PREREQ([2.69])
AC_INIT([OCaml],
m4_esyscmd([head -n1 VERSION | tr -d '\r\n']),
[caml-list@inria.fr],
## Output variables
AC_SUBST([CONFIGURE_ARGS])
+AC_SUBST([native_compiler])
AC_SUBST([VERSION], [AC_PACKAGE_VERSION])
AC_SUBST([CC])
# Note: This is present for the flexdll bootstrap where it exposed as the old
AC_SUBST([ocamlopt_cflags])
AC_SUBST([ocamlopt_cppflags])
AC_SUBST([iflexdir])
-AC_SUBST([hashbangscripts])
+AC_SUBST([long_shebang])
+AC_SUBST([shebangscripts])
AC_SUBST([AR])
AC_SUBST([RANLIB])
AC_SUBST([RANLIBCMD])
AC_SUBST([max_testsuite_dir_retries])
AC_SUBST([windows_unicode])
AC_SUBST([flat_float_array])
+AC_SUBST([function_sections])
AC_SUBST([afl])
AC_SUBST([force_safe_string])
AC_SUBST([default_safe_string])
AC_SUBST([flexdll_chain])
AC_SUBST([flexlink_flags])
AC_SUBST([PACKLD])
+AC_SUBST([stdlib_manpages])
## Generated files
S=asm
SO=dll
outputexe=-Fe
- mkexedebugflag=''
syslib='$(1).lib'],
[ccomptype=cc
S=s
profinfo_width="$enable_reserved_header_bits"],
[AC_MSG_ERROR([invalid argument to --enable-reserved-header-bits])])])
+AC_ARG_ENABLE([stdlib-manpages],
+ [AS_HELP_STRING([--disable-stdlib-manpages],
+ [do not build or install the library man pages])])
+
AC_ARG_VAR([WINDOWS_UNICODE_MODE],
[how to handle Unicode under Windows: ansi, compatible])
# explicitly passed.
#
# The configure-time behavior of OCaml 4.05 and older was equivalent
-# to --disable-force-safe-string DEFAULT_STRING=unsafe. OCaml 4.06
-# and later use --disable-force-safe-string DEFAULT_STRING=safe. We
-# expect --enable-force-safe-string to become the default in the future.
+# to --disable-force-safe-string DEFAULT_STRING=unsafe. With OCaml 4.06
+# and older was equivalent to --disable-force-safe-string DEFAULT_STRING=safe.
+# With OCaml 4.10 and later use --enable-force-safe-string DEFAULT_STRING=safe.
+# We expect the --disable-force-safe-string and DEFAULT_STRING=unsafe options
+# to be removed in the future.
AC_ARG_ENABLE([force-safe-string],
- [AS_HELP_STRING([--enable-force-safe-string],
- [force strings to be safe])])
+ [AS_HELP_STRING([--disable-force-safe-string],
+ [do not force strings to be safe])])
AC_ARG_VAR([DEFAULT_STRING],
[whether strings should be safe (default) or unsafe])
[AS_HELP_STRING([--disable-flat-float-array],
[do not use flat float arrays])])
+AC_ARG_ENABLE([function-sections],
+ [AS_HELP_STRING([--disable-function-sections],
+ [do not emit each function in a separate section])],
+ [],
+ [enable_function_sections=auto])
+
AC_ARG_WITH([afl],
[AS_HELP_STRING([--with-afl],
[use the AFL fuzzer])])
mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2) && ${RANLIB} \$(1)"
])
+## Find vendor of the C compiler
+OCAML_CC_VENDOR
+
# Determine how to call the C preprocessor directly.
# Most of the time, calling the C preprocessor through the C compiler is
# desirable and even important.
# We thus figure out how to invoke the C preprocessor directly but
# let the CPP variable untouched, except for the MSVC port where we set it
# manually to make sure the backward compatibility is preserved
-AS_CASE([$host],
- [*-pc-windows],
+AS_CASE([$ocaml_cv_cc_vendor],
+ [xlc-*],
+ [CPP="$CC -E -qnoppline"], # suppress incompatible XLC line directives
+ [msvc-*],
[CPP="$CC -nologo -EP"])
# Libraries to build depending on the host
## TODO: have two values, one for host and one for target
AC_SYS_INTERPRETER
+long_shebang=false
AS_IF(
[test "x$interpval" = "xyes"],
[AS_CASE([$host],
[*-cygwin|*-*-mingw32|*-pc-windows],
- [hashbangscripts=false],
- [hashbangscripts=true]
+ [shebangscripts=false],
+ [shebangscripts=true
+ prev_exec_prefix="$exec_prefix"
+ AS_IF([test "x$exec_prefix" = "xNONE"],[exec_prefix="$prefix"])
+ eval "expanded_bindir=\"$bindir\""
+ exec_prefix="$prev_exec_prefix"
+ # Assume maximum shebang is 128 chars; less #!, /ocamlrun, an optional
+ # 1 char suffix and the \0 leaving 115 characters
+ AS_IF([test "${#expanded_bindir}" -gt 115],[long_shebang=true])
+ ]
)],
- [hashbangscripts=false]
+ [shebangscripts=false]
)
# Are we building a cross-compiler
## Check for C99 support: done by libtool
## AC_PROG_CC_C99
-## Find vendor of the C compiler
-OCAML_CC_VENDOR
-
## Determine which flags to use for the C compiler
AS_CASE([$ocaml_cv_cc_vendor],
[xlc-*],
[outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i"], # all warnings enabled
[msvc-*],
- [outputobj=-Fo; CPP="cl -nologo -EP"; gcc_warnings=""],
+ [outputobj=-Fo; gcc_warnings=""],
[outputobj='-o $(EMPTY)'; AS_CASE([AC_PACKAGE_VERSION],
[*+dev*],
[gcc_warnings="-Wall -Werror"],
flexdir=`$flexlink -where | tr -d '\015'`
AS_IF([test -z "$flexdir"], [flexdir='$(ROOTDIR)/flexdll'])
iflexdir="-I\"$flexdir\""
- mkexedebugflag="-link -g"])],
+ mkexedebugflag=''])],
[*,x86_64-*-linux*],
AC_DEFINE([HAS_ARCH_CODE32], [1]),
[xlc*,powerpc-ibm-aix*],
AS_IF([$cc_has_fno_tree_vrp],
[internal_cflags="$internal_cflags -fno-tree-vrp"])])
+OCAML_CC_SUPPORTS_ALIGNED
+
# Configure the native-code compiler
arch=none
[AC_DEFINE([HAS_SECURE_GETENV])],
[AC_CHECK_FUNC([__secure_getenv], [AC_DEFINE([HAS___SECURE_GETENV])])])
-CPP_FLAGS="$saved_CPPFLAGS"
+CPPFLAGS="$saved_CPPFLAGS"
## issetugid
AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE])])
+## ffs or _BitScanForward
+
+AC_CHECK_FUNC([ffs], [AC_DEFINE([HAS_FFS])])
+AC_CHECK_FUNC([_BitScanForward], [AC_DEFINE([HAS_BITSCANFORWARD])])
+
## Determine whether the debugger should/can be built
AS_CASE([$enable_debugger],
AS_IF([test -z "$bfd_ldlibs"],
[unset ac_cv_lib_bfd_bfd_openr
AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd -ldl"], [], [-ldl])])
+ [bfd_ldlibs="-lbfd $DLLIBS"], [], [$DLLIBS])])
AS_IF([test -z "$bfd_ldlibs"],
[unset ac_cv_lib_bfd_bfd_openr
AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd -ldl -liberty"], [], [-ldl -liberty])])
+ [bfd_ldlibs="-lbfd $DLLIBS -liberty"], [], [$DLLIBS -liberty])])
AS_IF([test -z "$bfd_ldlibs"],
[unset ac_cv_lib_bfd_bfd_openr
AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd -ldl -liberty -lz"], [], [-ldl -liberty -lz])])
+ [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"], [], [$DLLIBS -liberty -lz])])
AS_IF([test -z "$bfd_ldlibs"],
[unset ac_cv_lib_bfd_bfd_openr
AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd -ldl -liberty -lz -lintl"], [],
- [-ldl -liberty -lz -lintl])])
+ [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"], [],
+ [$DLLIBS -liberty -lz -lintl])])
AS_IF([test -n "$bfd_ldlibs"],
[bfd_available=true
AC_DEFINE([HAS_LIBBFD])])])
[AC_DEFINE([FLAT_FLOAT_ARRAY])
flat_float_array=true])
+AS_IF([test x"$enable_function_sections" = "xno"],
+ [function_sections=false],
+ [AS_CASE([$arch],
+ [amd64|i386|arm64], # not supported on arm32, see issue #9124.
+ [AS_CASE([$target],
+ [*-cygwin*|*-mingw*|*-windows|*-apple-darwin*],
+ [function_sections=false;
+ AC_MSG_NOTICE([No support for function sections on $target.])],
+ [*],
+ [AS_CASE([$ocaml_cv_cc_vendor],
+ [gcc-[0123]-*|gcc-4-[01234567]],
+ [function_sections=false;
+ AC_MSG_NOTICE([Function sections are not
+ supported in GCC prior to version 4.8.])],
+ [clang-[012]-*|clang-3-[01234]],
+ [function_sections=false;
+ AC_MSG_NOTICE([Function sections are not supported
+ in Clang prior to version 3.5.])],
+ [gcc-*|clang-*],
+ [function_sections=true;
+ internal_cflags="$internal_cflags -ffunction-sections";
+ AC_DEFINE([FUNCTION_SECTIONS])],
+ [*],
+ [function_sections=false;
+ AC_MSG_NOTICE([Function sections are not supported by
+ $ocaml_cv_cc_vendor.])])])],
+ [function_sections=false]);
+ AS_IF([test x"$function_sections" = "xfalse"],
+ [AS_IF([test x"$enable_function_sections" = "xyes"],
+ [AC_MSG_ERROR([Function sections are not supported.])],
+ [AC_MSG_NOTICE([Disabling function sections.])])],
+ [])])
+
AS_IF([test x"$with_afl" = "xyes"],
[afl=true],
[afl=false])
-AS_IF([test x"$enable_force_safe_string" = "xyes"],
+AS_IF([test x"$enable_force_safe_string" = "xno"],
+ [force_safe_string=false],
[AC_DEFINE([CAML_SAFE_STRING])
- force_safe_string=true],
- [force_safe_string=false])
+ force_safe_string=true])
AS_IF([test x"$DEFAULT_STRING" = "xunsafe"],
[default_safe_string=false],
[i686-w64-mingw32], [prefix='C:/ocamlmgw'],
[x86_64-w64-mingw32], [prefix='C:/ocamlmgw64'],
[i686-pc-windows], [prefix='C:/ocamlms'],
- [x86_64-pc-windows], [prefix='C:/ocamlms64'])])
+ [x86_64-pc-windows], [prefix='C:/ocamlms64'])],
+ [AS_IF([test x"$unix_or_win32" = "xwin32" \
+ && test "$host_vendor-$host_os" != "$build_vendor-$build_os" ],
+ [AS_CASE([$build],
+ [*-pc-cygwin], [prefix=`cygpath -m "$prefix"`])])])
# Define a few macros that were defined in config/m-nt.h
# but whose value is not guessed properly by configure
AC_DEFINE([HAS_IPV6])
AC_DEFINE([HAS_NICE])])
+AS_IF([test x"$enable_stdlib_manpages" != "xno"],
+ [stdlib_manpages=true],[stdlib_manpages=false])
+
AC_OUTPUT
symbols.cmi \
pos.cmi \
parameters.cmi \
+ ../utils/misc.cmi \
../bytecomp/instruct.cmi \
exec.cmi \
+ events.cmi \
+ debugger_config.cmi \
debugcom.cmi \
checkpoints.cmi \
breakpoints.cmi
symbols.cmx \
pos.cmx \
parameters.cmx \
+ ../utils/misc.cmx \
../bytecomp/instruct.cmx \
exec.cmx \
+ events.cmx \
+ debugger_config.cmx \
debugcom.cmx \
checkpoints.cmx \
breakpoints.cmi
breakpoints.cmi : \
- ../bytecomp/instruct.cmi
+ events.cmi \
+ debugcom.cmi
checkpoints.cmo : \
primitives.cmi \
int64ops.cmi \
primitives.cmi \
../utils/misc.cmi \
int64ops.cmi \
+ ../bytecomp/instruct.cmi \
input_handling.cmi \
debugcom.cmi
debugcom.cmx : \
primitives.cmx \
../utils/misc.cmx \
int64ops.cmx \
+ ../bytecomp/instruct.cmx \
input_handling.cmx \
debugcom.cmi
debugcom.cmi : \
- primitives.cmi
+ primitives.cmi \
+ ../bytecomp/instruct.cmi
debugger_config.cmo : \
int64ops.cmi \
debugger_config.cmi
../bytecomp/instruct.cmi \
../typing/ident.cmi \
frames.cmi \
+ events.cmi \
../typing/env.cmi \
debugcom.cmi \
../typing/ctype.cmi \
../bytecomp/instruct.cmx \
../typing/ident.cmx \
frames.cmx \
+ events.cmx \
../typing/env.cmx \
debugcom.cmx \
../typing/ctype.cmx \
../typing/path.cmi \
parser_aux.cmi \
../parsing/longident.cmi \
- ../bytecomp/instruct.cmi \
../typing/ident.cmi \
+ events.cmi \
../typing/env.cmi \
debugcom.cmi
events.cmo : \
debugcom.cmx \
frames.cmi
frames.cmi : \
- ../bytecomp/instruct.cmi
+ events.cmi
history.cmo : \
primitives.cmi \
int64ops.cmi \
../parsing/longident.cmi \
int64ops.cmi \
input_handling.cmi \
+ debugcom.cmi \
parser.cmi
parser.cmx : \
parser_aux.cmi \
../parsing/longident.cmx \
int64ops.cmx \
input_handling.cmx \
+ debugcom.cmx \
parser.cmi
parser.cmi : \
parser_aux.cmi \
../parsing/longident.cmi
parser_aux.cmi : \
- ../parsing/longident.cmi
+ ../parsing/longident.cmi \
+ debugcom.cmi
pattern_matching.cmo : \
../typing/typedtree.cmi \
parser_aux.cmi \
pos.cmo : \
../parsing/location.cmi \
../bytecomp/instruct.cmi \
+ events.cmi \
pos.cmi
pos.cmx : \
../parsing/location.cmx \
../bytecomp/instruct.cmx \
+ events.cmx \
pos.cmi
pos.cmi : \
- ../bytecomp/instruct.cmi
+ events.cmi
primitives.cmo : \
$(UNIXDIR)/unix.cmi \
primitives.cmi
breakpoints.cmx \
show_information.cmi
show_information.cmi : \
- ../bytecomp/instruct.cmi
+ events.cmi
show_source.cmo : \
source.cmi \
primitives.cmi \
../bytecomp/bytesections.cmx \
symbols.cmi
symbols.cmi : \
- ../bytecomp/instruct.cmi
+ ../bytecomp/instruct.cmi \
+ events.cmi \
+ debugcom.cmi
time_travel.cmo : \
trap_barrier.cmi \
symbols.cmi \
include $(ROOTDIR)/Makefile.config
include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
DYNLINKDIR=$(ROOTDIR)/otherlibs/dynlink
UNIXDIR=$(ROOTDIR)/otherlibs/$(UNIXLIB)
CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
-CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -g -nostdlib -I $(ROOTDIR)/stdlib
+CAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
-safe-string -strict-sequence -strict-formats
LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR)
YACCFLAGS=
-CAMLLEX=$(CAMLRUN) $(ROOTDIR)/boot/ocamllex
-CAMLDEP=$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend
+CAMLLEX=$(BEST_OCAMLLEX)
+CAMLDEP=$(BEST_OCAMLDEP)
DEPFLAGS=-slash
DEPINCLUDES=$(INCLUDES)
attr_helper builtin_attributes pprintast)
typing_modules := $(addprefix typing/,\
- ident path types btype primitive typedtree subst predef datarepr \
- persistent_env env oprint ctype printtyp mtype envaux)
+ ident path type_immediacy types btype primitive typedtree subst predef \
+ datarepr persistent_env env oprint ctype printtyp mtype envaux)
file_formats_modules := $(addprefix file_formats/,\
cmi_format)
| sed -e 's,$(UNIXDIR)/,$$(UNIXDIR)/,' > .depend
lexer.ml: lexer.mll
- $(CAMLLEX) lexer.mll
+ $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
clean::
rm -f lexer.ml
beforedepend:: lexer.ml
open Checkpoints
open Debugcom
open Instruct
+open Events
open Printf
(*** Debugging. ***)
let breakpoint_number = ref 0
(* Breakpoint number -> event. *)
-let breakpoints = ref ([] : (int * debug_event) list)
+type breakpoint_id = int
+let breakpoints = ref ([] : (breakpoint_id * code_event) list)
(* Program counter -> breakpoint count. *)
-let positions = ref ([] : (int * int ref) list)
+let positions = ref ([] : (pc * int ref) list)
(* Versions of the breakpoint list. *)
let current_version = ref 0
(* List of breakpoints at `pc'. *)
let rec breakpoints_at_pc pc =
- begin try
- let ev = Symbols.event_at_pc pc in
- match ev.ev_repr with
- Event_child {contents = pc'} -> breakpoints_at_pc pc'
- | _ -> []
- with Not_found ->
- []
+ begin match Symbols.event_at_pc pc with
+ | {ev_frag = frag; ev_ev = {ev_repr = Event_child {contents = pos}}} ->
+ breakpoints_at_pc {frag; pos}
+ | _ -> []
+ | exception Not_found -> []
end
@
- List.map fst (List.filter (function (_, {ev_pos = pos}) -> pos = pc)
- !breakpoints)
+ List.map fst (List.filter
+ (function (_, {ev_frag = frag; ev_ev = {ev_pos = pos}}) ->
+ {frag; pos} = pc)
+ !breakpoints)
(* Is there a breakpoint at `pc' ? *)
let breakpoint_at_pc pc =
(*** Set and remove breakpoints ***)
+let print_pc out {frag;pos} = fprintf out "%d:%d" frag pos
+
(* Remove all breakpoints. *)
-let remove_breakpoints pos =
+let remove_breakpoints pcs =
if !debug_breakpoints then
- (print_string "Removing breakpoints..."; print_newline ());
+ printf "Removing breakpoints...\n%!";
List.iter
- (function (pos, _) ->
- if !debug_breakpoints then begin
- print_int pos;
- print_newline()
- end;
- reset_instr pos;
- Symbols.set_event_at_pc pos)
- pos
+ (function (pc, _) ->
+ if !debug_breakpoints then printf "%a\n%!" print_pc pc;
+ reset_instr pc;
+ Symbols.set_event_at_pc pc)
+ pcs
(* Set all breakpoints. *)
-let set_breakpoints pos =
+let set_breakpoints pcs =
if !debug_breakpoints then
- (print_string "Setting breakpoints..."; print_newline ());
+ printf "Setting breakpoints...\n%!";
List.iter
- (function (pos, _) ->
- if !debug_breakpoints then begin
- print_int pos;
- print_newline()
- end;
- set_breakpoint pos)
- pos
+ (function (pc, _) ->
+ if !debug_breakpoints then printf "%a\n%!" print_pc pc;
+ set_breakpoint pc)
+ pcs
(* Ensure the current version is installed in current checkpoint. *)
let update_breakpoints () =
set_breakpoints !positions;
copy_breakpoints ())
-let change_version version pos =
- Exec.protect
- (function () ->
- current_version := version;
- positions := pos)
-
(* Execute given function with no breakpoint in current checkpoint. *)
(* --- `goto' runs faster this way (does not stop on each breakpoint). *)
let execute_without_breakpoints f =
- let version = !current_version
- and pos = !positions
- in
- change_version 0 [];
- try
- f ();
- change_version version pos
- with
- _ ->
- change_version version pos
+ Misc.protect_refs [Misc.R (Debugger_config.break_on_load, false);
+ Misc.R (current_version, 0);
+ Misc.R (positions, []);
+ Misc.R (breakpoints, []);
+ Misc.R (breakpoint_number, 0)]
+ f
(* Add a position in the position list. *)
(* Change version if necessary. *)
end
(* Insert a new breakpoint in lists. *)
-let rec new_breakpoint =
- function
- {ev_repr = Event_child pc} ->
- new_breakpoint (Symbols.any_event_at_pc !pc)
- | event ->
- Exec.protect
- (function () ->
- incr breakpoint_number;
- insert_position event.ev_pos;
- breakpoints := (!breakpoint_number, event) :: !breakpoints);
- if !Parameters.breakpoint then begin
- printf "Breakpoint %d at %d: %s" !breakpoint_number event.ev_pos
- (Pos.get_desc event);
- print_newline ()
- end
+let rec new_breakpoint event =
+ match event with
+ {ev_frag=frag; ev_ev={ev_repr=Event_child pos}} ->
+ new_breakpoint (Symbols.any_event_at_pc {frag; pos=(!pos)})
+ | {ev_frag=frag; ev_ev={ev_pos=pos}} ->
+ let pc = {frag; pos} in
+ Exec.protect
+ (function () ->
+ incr breakpoint_number;
+ insert_position pc;
+ breakpoints := (!breakpoint_number, event) :: !breakpoints);
+ if !Parameters.breakpoint then
+ printf "Breakpoint %d at %a: %s\n%!" !breakpoint_number print_pc pc
+ (Pos.get_desc event)
(* Remove a breakpoint from lists. *)
let remove_breakpoint number =
try
let ev = List.assoc number !breakpoints in
- let pos = ev.ev_pos in
- Exec.protect
- (function () ->
- breakpoints := List.remove_assoc number !breakpoints;
- remove_position pos;
- if !Parameters.breakpoint then begin
- printf "Removed breakpoint %d at %d: %s" number ev.ev_pos
- (Pos.get_desc ev);
- print_newline ()
- end
- )
+ let pc = {frag = ev.ev_frag; pos=ev.ev_ev.ev_pos} in
+ Exec.protect
+ (function () ->
+ breakpoints := List.remove_assoc number !breakpoints;
+ remove_position pc;
+ if !Parameters.breakpoint then
+ printf "Removed breakpoint %d at %a: %s\n%!" number print_pc pc
+ (Pos.get_desc ev))
with
Not_found ->
prerr_endline ("No breakpoint number " ^ (Int.to_string number) ^ ".");
(*** Temporary breakpoints. ***)
(* Temporary breakpoint position. *)
-let temporary_breakpoint_position = ref (None : int option)
+let temporary_breakpoint_position = ref (None : pc option)
(* Execute `funct' with a breakpoint added at `pc'. *)
(* --- Used by `finish'. *)
(******************************* Breakpoints ***************************)
-open Instruct
-
(*** Debugging. ***)
val debug_breakpoints : bool ref
val breakpoints_count : unit -> int
-(* Breakpoint number -> debug_event_kind. *)
-val breakpoints : (int * debug_event) list ref
+(* Breakpoint number -> code_event. *)
+type breakpoint_id = int
+val breakpoints : (breakpoint_id * Events.code_event) list ref
(* Is there a breakpoint at `pc' ? *)
-val breakpoint_at_pc : int -> bool
+val breakpoint_at_pc : Debugcom.pc -> bool
(* List of breakpoints at `pc'. *)
-val breakpoints_at_pc : int -> int list
+val breakpoints_at_pc : Debugcom.pc -> breakpoint_id list
(*** Set and remove breakpoints ***)
val execute_without_breakpoints : (unit -> unit) -> unit
(* Insert a new breakpoint in lists. *)
-val new_breakpoint : debug_event -> unit
+val new_breakpoint : Events.code_event -> unit
(* Remove a breakpoint from lists. *)
-val remove_breakpoint : int -> unit
+val remove_breakpoint : breakpoint_id -> unit
val remove_all_breakpoints : unit -> unit
(*** Temporary breakpoints. ***)
(* Temporary breakpoint position. *)
-val temporary_breakpoint_position : int option ref
+val temporary_breakpoint_position : Debugcom.pc option ref
(* Execute `funct' with a breakpoint added at `pc'. *)
(* --- Used by `finish'. *)
-val exec_with_temporary_breakpoint : int -> (unit -> unit) -> unit
+val exec_with_temporary_breakpoint : Debugcom.pc -> (unit -> unit) -> unit
mutable c_state : checkpoint_state;
mutable c_parent : checkpoint;
mutable c_breakpoint_version : int;
- mutable c_breakpoints : (int * int ref) list;
- mutable c_trap_barrier : int
+ mutable c_breakpoints : (pc * int ref) list;
+ mutable c_trap_barrier : int;
+ mutable c_code_fragments : int list
}
(*** Pseudo-checkpoint `root'. ***)
c_parent = root;
c_breakpoint_version = 0;
c_breakpoints = [];
- c_trap_barrier = 0
+ c_trap_barrier = 0;
+ c_code_fragments = [0]
}
(*** Current state ***)
let current_report () =
!current_checkpoint.c_report
-let current_pc () =
- match current_report () with
- None | Some {rep_type = Exited | Uncaught_exc} -> None
- | Some {rep_program_pointer = pc } -> Some pc
-
let current_pc_sp () =
+ (* This pattern matching mimics the test used in debugger.c for
+ deciding whether or not PC/SP should be sent with the report.
+ See debugger.c, the [if] statement above the [command_loop]
+ label. *)
match current_report () with
- None | Some {rep_type = Exited | Uncaught_exc} -> None
- | Some {rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp)
+ | Some {rep_type = Event | Breakpoint;
+ rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp)
+ | _ -> None
+
+let current_pc () = Option.map fst (current_pc_sp ())
mutable c_state : checkpoint_state;
mutable c_parent : checkpoint;
mutable c_breakpoint_version : int;
- mutable c_breakpoints : (int * int ref) list;
- mutable c_trap_barrier : int}
+ mutable c_breakpoints : (pc * int ref) list;
+ mutable c_trap_barrier : int;
+ mutable c_code_fragments : int list}
(*** Pseudo-checkpoint `root'. ***)
(* --- Parents of all checkpoints which have no parent. *)
val current_time : unit -> int64
val current_report : unit -> report option
-val current_pc : unit -> int option
-val current_pc_sp : unit -> (int * int) option
+val current_pc : unit -> pc option
+val current_pc_sp : unit -> (pc * int) option
new_breakpoint (any_event_at_pc pc)
with
| Not_found ->
- eprintf "Can\'t add breakpoint at pc %i: no event there.@." pc;
+ eprintf "Can\'t add breakpoint at pc %i:%i: no event there.@."
+ pc.frag pc.pos;
raise Toplevel
let add_breakpoint_after_pc pc =
let rec try_add n =
if n < 3 then begin
try
- new_breakpoint (any_event_at_pc (pc + n * 4))
+ new_breakpoint (any_event_at_pc {pc with pos = pc.pos + n * 4})
with
| Not_found ->
try_add (n+1)
then Filename.chop_suffix m ".ml"
else m)
| None ->
- try
- (get_current_event ()).ev_module
- with
- | Not_found ->
- error "Not in a module."
+ try (get_current_event ()).ev_ev.ev_module
+ with Not_found -> error "Not in a module."
(** Toplevel. **)
let current_line = ref ""
ensure_loaded ();
reset_named_values ();
run ();
- show_current_event ppf;;
+ show_current_event ppf
let instr_reverse ppf lexbuf =
eol lexbuf;
function
None -> Env.empty
| Some ev ->
- Envaux.env_from_summary ev.Instruct.ev_typenv ev.Instruct.ev_typsubst
+ Envaux.env_from_summary ev.ev_ev.ev_typenv ev.ev_ev.ev_typsubst
let print_command depth ppf lexbuf =
let exprs = expression_list_eol Lexer.lexeme lexbuf in
new_breakpoint ev
| None ->
error "Can\'t add breakpoint at this point.")
- | BA_pc pc -> (* break PC *)
- add_breakpoint_at_pc pc
+ | BA_pc {frag; pos} -> (* break PC *)
+ add_breakpoint_at_pc {frag; pos}
| BA_function expr -> (* break FUNCTION *)
let env =
try
let ev = event_at_pos module_name 0 in
let ev_pos =
{Lexing.dummy_pos with
- pos_fname = (Events.get_pos ev).pos_fname} in
+ pos_fname = (Events.get_pos ev.ev_ev).pos_fname} in
let buffer =
try get_buffer ev_pos module_name with
| Not_found ->
| Some x -> x in
ensure_loaded ();
match current_report() with
- | None | Some {rep_type = Exited | Uncaught_exc} -> ()
+ | None | Some {rep_type = Exited | Uncaught_exc | Code_loaded _} -> ()
| Some _ ->
let frame_counter = ref 0 in
let print_frame first_frame last_frame = function
!checkpoints))
let info_one_breakpoint ppf (num, ev) =
- fprintf ppf "%3d %10d %s@." num ev.ev_pos (Pos.get_desc ev);
-;;
+ fprintf ppf "%3d %d:%10d %s@." num ev.ev_frag ev.ev_ev.ev_pos
+ (Pos.get_desc ev)
let info_breakpoints ppf lexbuf =
eol lexbuf;
fprintf ppf "Num Address Where@.";
List.iter (info_one_breakpoint ppf) (List.rev !breakpoints);
end
-;;
+
let info_events _ppf lexbuf =
ensure_loaded ();
in
print_endline ("Module: " ^ mdle);
print_endline " Address Characters Kind Repr.";
+ let frag, events = events_in_module mdle in
List.iter
(function ev ->
let start_char, end_char =
ev.ev_loc.Location.loc_start.Lexing.pos_cnum,
ev.ev_loc.Location.loc_end.Lexing.pos_cnum in
Printf.printf
- "%10d %6d-%-6d %10s %10s\n"
+ "%d:%10d %6d-%-6d %10s %10s\n"
+ frag
ev.ev_pos
start_char
end_char
Event_none -> ""
| Event_parent _ -> "(repr)"
| Event_child repr -> Int.to_string !repr))
- (events_in_module mdle)
+ events
(** User-defined printers **)
(* Breakpoints *)
{ instr_name = "break"; instr_prio = false;
instr_action = instr_break; instr_repeat = false; instr_help =
-"Set breakpoint at specified line or function.\
-\nSyntax: break function-name\
+"Set breakpoint.\
+\nSyntax: break\
+\n break function-name\
\n break @ [module] linenum\
-\n break @ [module] # characternum" };
+\n break @ [module] linenum columnnum\
+\n break @ [module] # characternum\
+\n break frag:pc\
+\n break pc" };
{ instr_name = "delete"; instr_prio = false;
instr_action = instr_delete; instr_repeat = false; instr_help =
"delete some breakpoints.\n\
"process to follow after forking.\n\
It can be either :\n\
child: the newly created process.\n\
- parent: the process that called fork.\n" }];
+ parent: the process that called fork.\n" };
+ { var_name = "break_on_load";
+ var_action = boolean_variable false break_on_load;
+ var_help =
+"whether to stop after loading new code (e.g. with Dynlink)." }];
info_list :=
(* info name, function, help *)
(* Modify the program code *)
-let set_event pos =
+type pc =
+ { frag : int;
+ pos : int; }
+
+let set_event {frag; pos} =
output_char !conn.io_out 'e';
+ output_binary_int !conn.io_out frag;
output_binary_int !conn.io_out pos
-let set_breakpoint pos =
+let set_breakpoint {frag; pos} =
output_char !conn.io_out 'B';
+ output_binary_int !conn.io_out frag;
output_binary_int !conn.io_out pos
-let reset_instr pos =
+let reset_instr {frag; pos} =
output_char !conn.io_out 'i';
+ output_binary_int !conn.io_out frag;
output_binary_int !conn.io_out pos
(* Basic commands for flow control *)
| Exited
| Trap_barrier
| Uncaught_exc
+ | Debug_info of Instruct.debug_event list array
+ | Code_loaded of int
+ | Code_unloaded of int
type report = {
rep_type : execution_summary;
- rep_event_count : int;
+ rep_event_count : int64;
rep_stack_pointer : int;
- rep_program_pointer : int
+ rep_program_pointer : pc
}
type checkpoint_report =
| 'x' -> Exited
| 's' -> Trap_barrier
| 'u' -> Uncaught_exc
- | _ -> Misc.fatal_error "Debugcom.do_go" in
+ | 'D' -> Debug_info (input_value !conn.io_in :
+ Instruct.debug_event list array)
+ | 'L' -> Code_loaded (input_binary_int !conn.io_in)
+ | 'U' -> Code_unloaded (input_binary_int !conn.io_in)
+ | c -> Misc.fatal_error (Printf.sprintf "Debugcom.do_go %c" c)
+ in
let event_counter = input_binary_int !conn.io_in in
let stack_pos = input_binary_int !conn.io_in in
- let pc = input_binary_int !conn.io_in in
+ let frag = input_binary_int !conn.io_in in
+ let pos = input_binary_int !conn.io_in in
{ rep_type = summary;
- rep_event_count = event_counter;
+ rep_event_count = Int64.of_int event_counter;
rep_stack_pointer = stack_pos;
- rep_program_pointer = pc })
+ rep_program_pointer = {frag; pos} })
let rec do_go n =
assert (n >= _0);
- if n > max_small_int then(
- ignore (do_go_smallint max_int);
- do_go (n -- max_small_int)
- )else(
+ if n > max_small_int then
+ begin match do_go_smallint max_int with
+ | { rep_type = Event } ->
+ do_go (n -- max_small_int)
+ | report ->
+ { report with
+ rep_event_count = report.rep_event_count ++ (n -- max_small_int) }
+ end
+ else
do_go_smallint (Int64.to_int n)
- )
-;;
(* Perform a checkpoint *)
output_char !conn.io_out '0';
flush !conn.io_out;
let stack_pos = input_binary_int !conn.io_in in
- let pc = input_binary_int !conn.io_in in
- (stack_pos, pc)
+ let frag = input_binary_int !conn.io_in in
+ let pos = input_binary_int !conn.io_in in
+ (stack_pos, {frag; pos})
let set_initial_frame () =
ignore(initial_frame ())
output_binary_int !conn.io_out stacksize;
flush !conn.io_out;
let stack_pos = input_binary_int !conn.io_in in
- let pc = if stack_pos = -1 then 0 else input_binary_int !conn.io_in in
- (stack_pos, pc)
+ let frag, pos =
+ if stack_pos = -1
+ then 0, 0
+ else let frag = input_binary_int !conn.io_in in
+ let pos = input_binary_int !conn.io_in in
+ frag, pos
+ in
+ (stack_pos, { frag; pos })
(* Get and set the current frame position *)
output_char !conn.io_out 'f';
flush !conn.io_out;
let stack_pos = input_binary_int !conn.io_in in
- let pc = input_binary_int !conn.io_in in
- (stack_pos, pc)
+ let frag = input_binary_int !conn.io_in in
+ let pos = input_binary_int !conn.io_in in
+ (stack_pos, {frag; pos})
let set_frame stack_pos =
output_char !conn.io_out 'S';
output_char !conn.io_out 'C';
output_remote_value !conn.io_out v;
flush !conn.io_out;
- input_binary_int !conn.io_in
+ let frag = input_binary_int !conn.io_in in
+ let pos = input_binary_int !conn.io_in in
+ {frag;pos}
let same rv1 rv2 =
match (rv1, rv2) with
(* Low-level communication with the debuggee *)
+type pc =
+ { frag : int;
+ pos : int; }
+
type execution_summary =
Event
| Breakpoint
| Exited
| Trap_barrier
| Uncaught_exc
+ | Debug_info of Instruct.debug_event list array
+ | Code_loaded of int
+ | Code_unloaded of int
type report =
{ rep_type : execution_summary;
- rep_event_count : int;
+ rep_event_count : int64;
rep_stack_pointer : int;
- rep_program_pointer : int }
+ rep_program_pointer : pc }
type checkpoint_report =
Checkpoint_done of int
val set_current_connection : Primitives.io_channel -> unit
(* Put an event at given pc *)
-val set_event : int -> unit
+val set_event : pc -> unit
(* Put a breakpoint at given pc *)
-val set_breakpoint : int -> unit
+val set_breakpoint : pc -> unit
(* Remove breakpoint or event at given pc *)
-val reset_instr : int -> unit
+val reset_instr : pc -> unit
(* Create a new checkpoint (the current process forks). *)
val do_checkpoint : unit -> checkpoint_report
(* Move to initial frame (that of current function). *)
(* Return stack position and current pc *)
-val initial_frame : unit -> int * int
+val initial_frame : unit -> int * pc
val set_initial_frame : unit -> unit
(* Get the current frame position *)
(* Return stack position and current pc *)
-val get_frame : unit -> int * int
+val get_frame : unit -> int * pc
(* Set the current frame *)
val set_frame : int -> unit
(* Move up one frame *)
(* Return stack position and current pc.
If there's no frame above, return (-1, 0). *)
-val up_frame : int -> int * int
+val up_frame : int -> int * pc
(* Set the trap barrier to given stack position. *)
val set_trap_barrier : int -> unit
val from_environment : int -> t
val global : int -> t
val accu : unit -> t
- val closure_code : t -> int
+ val closure_code : t -> pc
(* Returns a hexadecimal representation of the remote address,
or [""] if the value is local. *)
"Win32" -> false
| _ -> true)
+(* Whether to break when new code is loaded. *)
+let break_on_load = ref true
+
(*** Environment variables for debuggee. ***)
let environment = ref []
val checkpoint_small_step : int64 ref
val checkpoint_max_count : int ref
val make_checkpoints : bool ref
+val break_on_load : bool ref
(*** Environment variables for debuggee. ***)
open Instruct
open Types
open Parser_aux
+open Events
type error =
Unbound_identifier of Ident.t
with Symtable.Error _ -> raise(Error(Unbound_identifier id))
else
begin match event with
- Some ev ->
+ Some {ev_ev = ev} ->
begin try
let pos = Ident.find_same id ev.ev_compenv.ce_stack in
Debugcom.Remote_value.local (ev.ev_stacksize - pos)
fatal_error ("Cannot find address for: " ^ (Path.name path))
let rec expression event env = function
- E_ident lid ->
- begin try
- let (p, valdesc) = Env.lookup_value lid env in
- (begin match valdesc.val_kind with
- Val_ivar (_, cl_num) ->
- let (p0, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
- in
- let v = value_path event env p0 in
- let i = value_path event env p in
- Debugcom.Remote_value.field v (Debugcom.Remote_value.obj i)
- | _ ->
- value_path event env p
- end,
- Ctype.correct_levels valdesc.val_type)
- with Not_found ->
- raise(Error(Unbound_long_identifier lid))
- end
+ | E_ident lid -> begin
+ match Env.find_value_by_name lid env with
+ | (p, valdesc) ->
+ let v =
+ match valdesc.val_kind with
+ | Val_ivar (_, cl_num) ->
+ let (p0, _) =
+ Env.find_value_by_name
+ (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ let v = value_path event env p0 in
+ let i = value_path event env p in
+ Debugcom.Remote_value.field v (Debugcom.Remote_value.obj i)
+ | _ ->
+ value_path event env p
+ in
+ let typ = Ctype.correct_levels valdesc.val_type in
+ v, typ
+ | exception Not_found ->
+ raise(Error(Unbound_long_identifier lid))
+ end
| E_result ->
begin match event with
- Some {ev_kind = Event_after ty; ev_typsubst = subst}
+ Some {ev_ev = {ev_kind = Event_after ty; ev_typsubst = subst}}
when !Frames.current_frame = 0 ->
(Debugcom.Remote_value.accu(), Subst.type_expr subst ty)
| _ ->
| Unknown_name n ->
fprintf ppf "@[Unknown value name $%i@]@." n
| Tuple_index(ty, len, pos) ->
- Printtyp.reset_and_mark_loops ty;
fprintf ppf
"@[Cannot extract field number %i from a %i-tuple of type@ %a@]@."
pos len Printtyp.type_expr ty
open Format
val expression :
- Instruct.debug_event option -> Env.t -> expression ->
+ Events.code_event option -> Env.t -> expression ->
Debugcom.Remote_value.t * type_expr
type error =
open Instruct
+type code_event =
+ { ev_frag : int;
+ ev_ev : Instruct.debug_event }
+
let get_pos ev =
match ev.ev_kind with
| Event_before -> ev.ev_loc.Location.loc_start
(* Event at current position *)
let current_event =
- ref (None : debug_event option)
+ ref (None : code_event option)
(* Current position in source. *)
(* Raise `Not_found' if not on an event (beginning or end of program). *)
match !current_event with
None ->
raise Not_found
- | Some {ev_kind = Event_before} ->
+ | Some {ev_ev = {ev_kind = Event_before}} ->
true
| _ ->
false
open Instruct
+(* A debug event associated with a code fragment. *)
+type code_event =
+ { ev_frag : int;
+ ev_ev : Instruct.debug_event }
+
val get_pos : debug_event -> Lexing.position;;
(** Current events. **)
(* The event at current position. *)
-val current_event : debug_event option ref
+val current_event : code_event option ref
(* Current position in source. *)
(* Raise `Not_found' if not on an event (beginning or end of program). *)
-val get_current_event : unit -> debug_event
+val get_current_event : unit -> code_event
val current_event_is_before : unit -> bool
let current_frame = ref 0
(* Event at selected position *)
-let selected_event = ref (None : debug_event option)
+let selected_event = ref (None : code_event option)
(* Selected position in source. *)
(* Raise `Not_found' if not on an event. *)
match !selected_event with
None ->
raise Not_found
- | Some ev ->
+ | Some {ev_ev=ev} ->
(ev.ev_module,
(Events.get_pos ev).Lexing.pos_lnum,
(Events.get_pos ev).Lexing.pos_cnum - (Events.get_pos ev).Lexing.pos_bol)
match !selected_event with
None ->
raise Not_found
- | Some {ev_kind = Event_before} ->
+ | Some {ev_ev={ev_kind = Event_before}} ->
true
| _ ->
false
let rec move_up frame_count event =
if frame_count <= 0 then event else begin
- let (sp, pc) = up_frame event.ev_stacksize in
+ let (sp, pc) = up_frame event.ev_ev.ev_stacksize in
if sp < 0 then raise Not_found;
move_up (frame_count - 1) (any_event_at_pc pc)
end
let do_backtrace action =
match !current_event with
None -> Misc.fatal_error "Frames.do_backtrace"
- | Some curr_ev ->
+ | Some ev ->
let (initial_sp, _) = get_frame() in
set_initial_frame();
- let event = ref curr_ev in
+ let event = ref ev in
begin try
while action (Some !event) do
- let (sp, pc) = up_frame !event.ev_stacksize in
+ let (sp, pc) = up_frame !event.ev_ev.ev_stacksize in
if sp < 0 then raise Exit;
event := any_event_at_pc pc
done
(****************************** Frames *********************************)
-open Instruct
+open Events
(* Current frame number *)
val current_frame : int ref
-(* Event at selected position. *)
-val selected_event : debug_event option ref
+(* Fragment and event at selected position. *)
+val selected_event : code_event option ref
(* Selected position in source (module, line, column). *)
(* Raise `Not_found' if not on an event. *)
or None if we've encountered a stack frame with no debugging info
attached. Stop when the function returns false, or frame with no
debugging info reached, or top of stack reached. *)
-val do_backtrace : (debug_event option -> bool) -> unit
+val do_backtrace : (code_event option -> bool) -> unit
(* Return the number of frames in the stack, or (-1) if it can't be
determined because some frames have no debugging info. *)
{ AT }
| "$"
{ DOLLAR }
+ | ":"
+ { COLON }
| "!"
{ BANG }
| "("
let match_printer_type desc typename =
let printer_type =
- try
- Env.lookup_type (Ldot(Lident "Topdirs", typename)) Env.empty
- with Not_found ->
- raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename)))) in
+ match
+ Env.find_type_by_name
+ (Ldot(Lident "Topdirs", typename)) Env.empty
+ with
+ | path, _ -> path
+ | exception Not_found ->
+ raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename))))
+ in
Ctype.begin_def();
let ty_arg = Ctype.newvar() in
Ctype.unify Env.empty
ty_arg
let find_printer_type lid =
- try
- let (path, desc) = Env.lookup_value lid Env.empty in
- let (ty_arg, is_old_style) =
- try
- (match_printer_type desc "printer_type_new", false)
- with Ctype.Unify _ ->
- (match_printer_type desc "printer_type_old", true) in
- (ty_arg, path, is_old_style)
- with
- | Not_found -> raise(Error(Unbound_identifier lid))
- | Ctype.Unify _ -> raise(Error(Wrong_type lid))
+ match Env.find_value_by_name lid Env.empty with
+ | (path, desc) -> begin
+ match match_printer_type desc "printer_type_new" with
+ | ty_arg -> (ty_arg, path, false)
+ | exception Ctype.Unify _ -> begin
+ match match_printer_type desc "printer_type_old" with
+ | ty_arg -> (ty_arg, path, true)
+ | exception Ctype.Unify _ -> raise(Error(Wrong_type lid))
+ end
+ end
+ | exception Not_found ->
+ raise(Error(Unbound_identifier lid))
let install_printer ppf lid =
let (ty_arg, path, is_old_style) = find_printer_type lid in
open Input_handling
open Longident
open Parser_aux
+open Debugcom
%}
%token STAR /* * */
%token MINUS /* - */
%token DOT /* . */
+%token COLON /* : */
%token HASH /* # */
%token AT /* @ */
%token DOLLAR /* $ */
break_argument_eol :
end_of_line { BA_none }
- | integer_eol { BA_pc $1 }
+ | integer_eol { BA_pc {frag = 0; pos = $1} }
+ | INTEGER COLON integer_eol { BA_pc {frag = to_int $1;
+ pos = $3} }
| expression end_of_line { BA_function $1 }
| AT opt_longident INTEGER opt_integer_eol { BA_pos1 ($2, (to_int $3), $4)}
| AT opt_longident HASH integer_eol { BA_pos2 ($2, $4) }
type break_arg =
BA_none (* break *)
- | BA_pc of int (* break PC *)
+ | BA_pc of Debugcom.pc (* break FRAG PC *)
| BA_function of expression (* break FUNCTION *)
| BA_pos1 of Longident.t option * int * int option
(* break @ [MODULE] LINE [POS] *)
(* *)
(**************************************************************************)
-open Instruct;;
-open Lexing;;
-open Location;;
+open Instruct
+open Lexing
+open Location
+open Events
let get_desc ev =
- let loc = ev.ev_loc in
+ let loc = ev.ev_ev.ev_loc in
Printf.sprintf "file %s, line %d, characters %d-%d"
loc.loc_start.pos_fname loc.loc_start.pos_lnum
(loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1)
(loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1)
-;;
(* *)
(**************************************************************************)
-val get_desc : Instruct.debug_event -> string;;
+val get_desc : Events.code_event -> string;;
| _ ->
let n = name_value obj ty in
fprintf ppf "$%i" n in
- Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[<2>%a:@ %a@ =@ %a@]@."
print_value_name exp
Printtyp.type_expr ty
prerr_endline "Program not found.";
raise Toplevel;
end;
- Symbols.read_symbols !program_name;
+ Symbols.clear_symbols ();
+ Symbols.read_symbols 0 !program_name;
Load_path.init (Load_path.get_paths () @ !Symbols.program_source_dirs);
Envaux.reset_cache ();
if !debug_loading then
open_connection !socket_name
(function () ->
go_to _0;
- Symbols.set_all_events();
+ Symbols.set_all_events 0;
exit_main_loop ())
(* Ensure the program is already loaded. *)
fprintf ppf "Time: %Li" (current_time ());
(match current_pc () with
| Some pc ->
- fprintf ppf " - pc: %i" pc
+ fprintf ppf " - pc: %i:%i" pc.frag pc.pos
| _ -> ());
end;
update_current_event ();
fprintf ppf "Beginning of program.@.";
show_no_point ()
| Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->
- let ev = get_current_event () in
+ let ev = (get_current_event ()).ev_ev in
if !Parameters.time then fprintf ppf " - module %s@." ev.ev_module;
(match breakpoints_at_pc pc with
| [] ->
@[Uncaught exception:@ %a@]@."
Printval.print_exception (Debugcom.Remote_value.accu ());
show_no_point ()
- | Some {rep_type = Trap_barrier} ->
- (* Trap_barrier not visible outside *)
- (* of module `time_travel'. *)
+ | Some {rep_type = Code_loaded frag} ->
+ let mds = String.concat ", " (Symbols.modules_in_code_fragment frag) in
+ fprintf ppf "@.Module(s) %s loaded.@." mds;
+ show_no_point ()
+ | Some {rep_type = Trap_barrier}
+ | Some {rep_type = Debug_info _}
+ | Some {rep_type = Code_unloaded _} ->
+ (* Not visible outside *)
+ (* of module `time_travel'. *)
if !Parameters.time then fprintf ppf "@.";
Misc.fatal_error "Show_information.show_current_event"
(* Display short information about one frame. *)
-let show_one_frame framenum ppf event =
- let pos = Events.get_pos event in
+let show_one_frame framenum ppf ev =
+ let pos = Events.get_pos ev.ev_ev in
let cnum =
try
- let buffer = get_buffer pos event.ev_module in
+ let buffer = get_buffer pos ev.ev_ev.ev_module in
snd (start_and_cnum buffer pos)
with _ -> pos.Lexing.pos_cnum in
if !machine_readable then
- fprintf ppf "#%i Pc: %i %s char %i@."
- framenum event.ev_pos event.ev_module
+ fprintf ppf "#%i Pc: %i:%i %s char %i@."
+ framenum ev.ev_frag ev.ev_ev.ev_pos ev.ev_ev.ev_module
cnum
else
fprintf ppf "#%i %s %s:%i:%i@."
- framenum event.ev_module
+ framenum ev.ev_ev.ev_module
pos.Lexing.pos_fname pos.Lexing.pos_lnum
(pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1)
fprintf ppf "@.No frame selected.@."
| Some sel_ev ->
show_one_frame !current_frame ppf sel_ev;
- begin match breakpoints_at_pc sel_ev.ev_pos with
+ begin match breakpoints_at_pc
+ {frag=sel_ev.ev_frag; pos = sel_ev.ev_ev.ev_pos} with
| [] -> ()
| [breakpoint] ->
fprintf ppf "Breakpoint: %i@." breakpoint
List.iter (function x -> fprintf ppf "%i " x) l)
(List.sort compare breakpoints);
end;
- show_point sel_ev selected
+ show_point sel_ev.ev_ev selected
(* *)
(**************************************************************************)
-open Format;;
+open Format
(* Display information about the current event. *)
-val show_current_event : formatter -> unit;;
+val show_current_event : formatter -> unit
(* Display information about the current frame. *)
(* --- `select frame' must have succeeded before calling this function. *)
-val show_current_frame : formatter -> bool -> unit;;
+val show_current_frame : formatter -> bool -> unit
(* Display short information about one frame. *)
-val show_one_frame : int -> formatter -> Instruct.debug_event -> unit
+val show_one_frame : int -> formatter -> Events.code_event -> unit
open Instruct
open Debugger_config (* Toplevel *)
open Program_loading
+open Debugcom
+open Events
module String = Misc.Stdlib.String
let modules =
let program_source_dirs =
ref ([] : string list)
-let events =
- ref ([] : debug_event list)
let events_by_pc =
- (Hashtbl.create 257 : (int, debug_event) Hashtbl.t)
+ (Hashtbl.create 257 : (pc, debug_event) Hashtbl.t)
let events_by_module =
- (Hashtbl.create 17 : (string, debug_event array) Hashtbl.t)
+ (Hashtbl.create 17 : (string, int * debug_event array) Hashtbl.t)
let all_events_by_module =
- (Hashtbl.create 17 : (string, debug_event list) Hashtbl.t)
+ (Hashtbl.create 17 : (string, int * debug_event list) Hashtbl.t)
let partition_modules evl =
let rec partition_modules' ev evl =
close_in_noerr ic;
!eventlists, !dirs
-let read_symbols bytecode_file =
- let all_events, all_dirs = read_symbols' bytecode_file in
-
- modules := []; events := [];
- program_source_dirs := String.Set.elements all_dirs;
+let clear_symbols () =
+ modules := [];
+ program_source_dirs := [];
Hashtbl.clear events_by_pc; Hashtbl.clear events_by_module;
- Hashtbl.clear all_events_by_module;
+ Hashtbl.clear all_events_by_module
+let add_symbols frag all_events =
List.iter
(fun evl ->
List.iter
(fun ev ->
- events := ev :: !events;
- Hashtbl.add events_by_pc ev.ev_pos ev)
+ Hashtbl.add events_by_pc {frag; pos = ev.ev_pos} ev)
evl)
all_events;
in
let sorted_evl = List.sort cmp evl in
modules := md :: !modules;
- Hashtbl.add all_events_by_module md sorted_evl;
+ Hashtbl.add all_events_by_module md (frag, sorted_evl);
let real_evl =
List.filter
(function
| _ -> true)
sorted_evl
in
- Hashtbl.add events_by_module md (Array.of_list real_evl))
+ Hashtbl.add events_by_module md (frag, Array.of_list real_evl))
all_events
+let read_symbols frag bytecode_file =
+ let all_events, all_dirs = read_symbols' bytecode_file in
+ program_source_dirs := !program_source_dirs @ (String.Set.elements all_dirs);
+ add_symbols frag all_events
+
+let erase_symbols frag =
+ let pcs = Hashtbl.fold (fun pc _ pcs ->
+ if pc.frag = frag then pc :: pcs else pcs)
+ events_by_pc []
+ in
+ List.iter (Hashtbl.remove events_by_pc) pcs;
+
+ let mds = Hashtbl.fold (fun md (frag', _) mds ->
+ if frag' = frag then md :: mds else mds)
+ events_by_module []
+ in
+ List.iter (Hashtbl.remove events_by_module) mds;
+ List.iter (Hashtbl.remove all_events_by_module) mds;
+ modules := List.filter (fun md -> not (List.mem md mds)) !modules
+
+let code_fragments () =
+ let frags =
+ Hashtbl.fold
+ (fun _ (frag, _) l -> frag :: l)
+ all_events_by_module []
+ in
+ List.sort_uniq compare frags
+
+let modules_in_code_fragment frag' =
+ Hashtbl.fold (fun md (frag, _) l ->
+ if frag' = frag then md :: l else l)
+ all_events_by_module []
+
let any_event_at_pc pc =
- Hashtbl.find events_by_pc pc
+ { ev_frag = pc.frag; ev_ev = Hashtbl.find events_by_pc pc }
let event_at_pc pc =
- let ev = any_event_at_pc pc in
- match ev.ev_kind with
- Event_pseudo -> raise Not_found
- | _ -> ev
+ match any_event_at_pc pc with
+ { ev_ev = { ev_kind = Event_pseudo } } -> raise Not_found
+ | ev -> ev
let set_event_at_pc pc =
- try ignore(event_at_pc pc); Debugcom.set_event pc
+ try ignore(event_at_pc pc); set_event pc
with Not_found -> ()
(* List all events in module *)
try
Hashtbl.find all_events_by_module mdle
with Not_found ->
- []
+ 0, []
(* Binary search of event at or just after char *)
let find_event ev char =
(* Return first event after the given position. *)
(* Raise [Not_found] if module is unknown or no event is found. *)
let event_at_pos md char =
- let ev = Hashtbl.find events_by_module md in
- ev.(find_event ev char)
+ let ev_frag, ev = Hashtbl.find events_by_module md in
+ { ev_frag; ev_ev = ev.(find_event ev char) }
(* Return event closest to given position *)
(* Raise [Not_found] if module is unknown or no event is found. *)
let event_near_pos md char =
- let ev = Hashtbl.find events_by_module md in
+ let ev_frag, ev = Hashtbl.find events_by_module md in
try
let pos = find_event ev char in
(* Desired event is either ev.(pos) or ev.(pos - 1),
whichever is closest *)
if pos > 0 && char - (Events.get_pos ev.(pos - 1)).Lexing.pos_cnum
<= (Events.get_pos ev.(pos)).Lexing.pos_cnum - char
- then ev.(pos - 1)
- else ev.(pos)
+ then { ev_frag; ev_ev = ev.(pos - 1) }
+ else { ev_frag; ev_ev = ev.(pos) }
with Not_found ->
let pos = Array.length ev - 1 in
if pos < 0 then raise Not_found;
- ev.(pos)
+ { ev_frag; ev_ev = ev.(pos) }
(* Flip "event" bit on all instructions *)
-let set_all_events () =
+let set_all_events frag =
Hashtbl.iter
- (fun _pc ev ->
+ (fun pc ev ->
match ev.ev_kind with
Event_pseudo -> ()
- | _ -> Debugcom.set_event ev.ev_pos)
+ | _ when pc.frag = frag -> set_event pc
+ | _ -> ())
events_by_pc
-
(* Previous `pc'. *)
(* Save time if `update_current_event' is called *)
(* several times at the same point. *)
-let old_pc = ref (None : int option)
+let old_pc = ref (None : pc option)
(* Recompute the current event *)
let update_current_event () =
(* *)
(**************************************************************************)
+open Events
+
(* Modules used by the program. *)
val modules : string list ref
* compiled *)
val program_source_dirs : string list ref
-(* Read debugging info from executable file *)
-val read_symbols : string -> unit
+(* Clear loaded symbols *)
+val clear_symbols : unit -> unit
+
+(* Read debugging info from executable or dynlinkable file
+ and associate with given code fragment *)
+val read_symbols : int -> string -> unit
+
+(* Add debugging info from memory and associate with given
+ code fragment *)
+val add_symbols : int -> Instruct.debug_event list list -> unit
+
+(* Erase debugging info associated with given code fragment *)
+val erase_symbols : int -> unit
-(* Flip "event" bit on all instructions *)
-val set_all_events : unit -> unit
+(* Return the list of all code fragments that have debug info associated *)
+val code_fragments : unit -> int list
+
+(* Flip "event" bit on all instructions in given fragment *)
+val set_all_events : int -> unit
(* Return event at given PC, or raise Not_found *)
(* Can also return pseudo-event at beginning of functions *)
-val any_event_at_pc : int -> Instruct.debug_event
+val any_event_at_pc : Debugcom.pc -> code_event
(* Return event at given PC, or raise Not_found *)
-val event_at_pc : int -> Instruct.debug_event
+val event_at_pc : Debugcom.pc -> code_event
+
(* Set event at given PC *)
-val set_event_at_pc : int -> unit
+val set_event_at_pc : Debugcom.pc -> unit
(* List the events in `module'. *)
-val events_in_module : string -> Instruct.debug_event list
+val events_in_module : string -> int * Instruct.debug_event list
+
+(* List the modules in given code fragment. *)
+val modules_in_code_fragment : int -> string list
(* First event after the given position. *)
(* --- Raise `Not_found' if no such event. *)
-val event_at_pos : string -> int -> Instruct.debug_event
+val event_at_pos : string -> int -> code_event
(* Closest event from given position. *)
(* --- Raise `Not_found' if no such event. *)
-val event_near_pos : string -> int -> Instruct.debug_event
+val event_near_pos : string -> int -> code_event
(* Recompute the current event *)
val update_current_event : unit -> unit
if not checkpoint.c_valid then
wait_for_connection checkpoint;
current_checkpoint := checkpoint;
+ let dead_frags = List.filter (fun frag ->
+ not (List.mem frag checkpoint.c_code_fragments))
+ (Symbols.code_fragments ())
+ in
+ List.iter Symbols.erase_symbols dead_frags;
set_current_connection checkpoint.c_fd
(* Kill `checkpoint'. *)
c_parent = checkpoint;
c_breakpoint_version = checkpoint.c_breakpoint_version;
c_breakpoints = checkpoint.c_breakpoints;
- c_trap_barrier = checkpoint.c_trap_barrier}
+ c_trap_barrier = checkpoint.c_trap_barrier;
+ c_code_fragments = checkpoint.c_code_fragments}
in
checkpoints := list_replace checkpoint new_checkpoint !checkpoints;
set_current_checkpoint checkpoint;
(* Information about last breakpoint encountered *)
let last_breakpoint = ref None
+(* Last debug info loaded *)
+let last_debug_info = ref None
+
+let rec do_go_dynlink steps =
+ match do_go steps with
+ | { rep_type = Code_loaded frag; rep_event_count = steps } as report ->
+ begin match !last_debug_info with
+ | Some di ->
+ Symbols.add_symbols frag di;
+ Symbols.set_all_events frag;
+ last_debug_info := None
+ | None -> assert false
+ end;
+ if !break_on_load then report
+ else do_go_dynlink steps
+ | { rep_type = Code_unloaded frag; rep_event_count = steps } ->
+ Symbols.erase_symbols frag;
+ do_go_dynlink steps
+ | { rep_type = Debug_info di; rep_event_count = steps } ->
+ last_debug_info := Some (Array.to_list di);
+ do_go_dynlink steps
+ | report -> report
+
(* Ensure we stop on an event. *)
let rec stop_on_event report =
match report with
print_string "Searching next event...";
print_newline ()
end;
- let report = do_go _1 in
+ let report = do_go_dynlink _1 in
!current_checkpoint.c_report <- Some report;
stop_on_event report
update_breakpoints ();
update_trap_barrier ();
!current_checkpoint.c_state <- C_running duration;
- let report = do_go duration in
+ let report = do_go_dynlink duration in
!current_checkpoint.c_report <- Some report;
!current_checkpoint.c_state <- C_stopped;
+ !current_checkpoint.c_code_fragments <- Symbols.code_fragments ();
if report.rep_type = Event then begin
!current_checkpoint.c_time <-
!current_checkpoint.c_time ++ duration;
else begin
!current_checkpoint.c_time <-
!current_checkpoint.c_time ++ duration
- -- (Int64.of_int report.rep_event_count) ++ _1;
+ -- report.rep_event_count ++ _1;
interrupted := true;
last_breakpoint := None;
stop_on_event report
c_parent = root;
c_breakpoint_version = 0;
c_breakpoints = [];
- c_trap_barrier = 0}
+ c_trap_barrier = 0;
+ c_code_fragments = [0]}
in
insert_checkpoint new_checkpoint
(Some (pc, _)) as state when breakpoint_at_pc pc -> state
| _ -> None)
-
(* Run from `time_max' back to `time'. *)
(* --- Assume 0 <= time < time_max *)
let rec back_to time time_max =
None ->
prerr_endline "`finish' not meaningful in outermost frame.";
raise Toplevel
- | Some curr_event ->
+ | Some {ev_ev={ev_stacksize}} ->
set_initial_frame();
- let (frame, pc) = up_frame curr_event.ev_stacksize in
+ let (frame, pc) = up_frame ev_stacksize in
if frame < 0 then begin
prerr_endline "`finish' not meaningful in outermost frame.";
raise Toplevel
match !current_event with
None -> (* Beginning of the program. *)
step _1
- | Some event1 ->
+ | Some {ev_ev={ev_stacksize=ev_stacksize1}} ->
let (frame1, _pc1) = initial_frame() in
step _1;
if not !interrupted then begin
Symbols.update_current_event ();
match !current_event with
None -> ()
- | Some event2 ->
+ | Some {ev_ev={ev_stacksize=ev_stacksize2}} ->
let (frame2, _pc2) = initial_frame() in
(* Call `finish' if we've entered a function. *)
if frame1 >= 0 && frame2 >= 0 &&
- frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize
+ frame2 - ev_stacksize2 > frame1 - ev_stacksize1
then finish()
end
None ->
prerr_endline "`start not meaningful in outermost frame.";
raise Toplevel
- | Some curr_event ->
+ | Some {ev_ev={ev_stacksize}} ->
let (frame, _) = initial_frame() in
- let (frame', pc) = up_frame curr_event.ev_stacksize in
+ let (frame', pc) = up_frame ev_stacksize in
if frame' < 0 then begin
prerr_endline "`start not meaningful in outermost frame.";
raise Toplevel
prerr_endline "Calling function has no debugging information.";
raise Toplevel
with
- {ev_info = Event_return nargs} -> nargs
+ {ev_ev = {ev_info = Event_return nargs}} -> nargs
| _ -> Misc.fatal_error "Time_travel.start"
in
let offset = if nargs < 4 then 1 else 2 in
- let pc = pc - 4 * offset in
+ let pc = { pc with pos = pc.pos - 4 * offset } in
while
exec_with_temporary_breakpoint pc back_run;
match !last_breakpoint with
step _minus1;
(not !interrupted)
&&
- (frame' - nargs > frame - curr_event.ev_stacksize)
+ (frame' - nargs > frame - ev_stacksize)
| _ ->
false
do
match !current_event with
None -> (* End of the program. *)
step _minus1
- | Some event1 ->
+ | Some {ev_ev={ev_stacksize=ev_stacksize1}} ->
let (frame1, _pc1) = initial_frame() in
step _minus1;
if not !interrupted then begin
Symbols.update_current_event ();
match !current_event with
None -> ()
- | Some event2 ->
+ | Some {ev_ev={ev_stacksize=ev_stacksize2}} ->
let (frame2, _pc2) = initial_frame() in
(* Call `start' if we've entered a function. *)
if frame1 >= 0 && frame2 >= 0 &&
- frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize
+ frame2 - ev_stacksize2 > frame1 - ev_stacksize1
then start()
end
| "clambda-checks" -> set "clambda-checks" [ clambda_checks ] v
+ | "function-sections" ->
+ set "function-sections" [ Clflags.function_sections ] v
(* assembly sources *)
| "s" ->
set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v
if List.length (List.filter (function
| ProcessImplementation _
- | ProcessInterface _
+ | ProcessInterface _ -> true
| _ -> false) !deferred_actions) > 1 then
fatal "Options -c -o are incompatible with compiling multiple files"
end;
(* Error messages to standard error formatter *)
let ppf = Format.err_formatter
-let vmthread_removed_message = "\
-The -vmthread argument of ocamlc is no longer supported\n\
-since OCaml 4.09.0. Please switch to system threads, which have the\n\
-same API. Lightweight threads with VM-level scheduling are provided by\n\
-third-party libraries such as Lwt, but with a different API."
-
-module Options = Main_args.Make_bytecomp_options (struct
- let set r () = r := true
- let unset r () = r := false
- let _a = set make_archive
- let _absname = set Clflags.absname
- let _alert = Warnings.parse_alert_option
- let _annot = set annotations
- let _binannot = set binary_annotations
- let _c = set compile_only
- let _cc s = c_compiler := Some s
- let _cclib s = Compenv.defer (ProcessObjects (Misc.rev_split_words s))
- let _ccopt s = first_ccopts := s :: !first_ccopts
- let _compat_32 = set bytecode_compatible_32
- let _config = Misc.show_config_and_exit
- let _config_var = Misc.show_config_variable_and_exit
- let _custom = set custom_runtime
- let _no_check_prims = set no_check_prims
- let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s))
- let _dllpath s = dllpaths := !dllpaths @ [s]
- let _for_pack s = for_package := Some s
- let _g = set debug
- let _i () =
- print_types := true;
- compile_only := true;
- stop_after := Some Compiler_pass.Typing;
- ()
- let _stop_after pass =
- let module P = Compiler_pass in
- begin match P.of_string pass with
- | None -> () (* this should not occur as we use Arg.Symbol *)
- | Some pass ->
- stop_after := Some pass;
- begin match pass with
- | P.Parsing | P.Typing ->
- compile_only := true
- end;
- end
- let _I s = include_dirs := s :: !include_dirs
- let _impl = impl
- let _intf = intf
- let _intf_suffix s = Config.interface_suffix := s
- let _keep_docs = set keep_docs
- let _no_keep_docs = unset keep_docs
- let _keep_locs = set keep_locs
- let _no_keep_locs = unset keep_locs
- let _labels = unset classic
- let _linkall = set link_everything
- let _make_runtime () =
- custom_runtime := true; make_runtime := true; link_everything := true
- let _alias_deps = unset transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = unset applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noautolink = set no_auto_link
- let _nostdlib = set no_std_include
- let _o s = output_name := Some s
- let _opaque = set opaque
- let _open s = open_modules := s :: !open_modules
- let _output_obj () = output_c_object := true; custom_runtime := true
- let _output_complete_obj () =
- output_c_object := true;
- output_complete_object := true;
- custom_runtime := true
- let _pack = set make_package
- let _pp s = preprocessor := Some s
- let _ppx s = first_ppx := s :: !first_ppx
- let _plugin _p = plugin := true
- let _principal = set principal
- let _no_principal = unset principal
- let _rectypes = set recursive_types
- let _no_rectypes = unset recursive_types
- let _runtime_variant s = runtime_variant := s
- let _with_runtime = set with_runtime
- let _without_runtime = unset with_runtime
- let _safe_string = unset unsafe_string
- let _short_paths = unset real_paths
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = unset strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = unset strict_formats
- let _thread = set use_threads
- let _vmthread = fun () -> fatal vmthread_removed_message
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = unset unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _use_prims s = use_prims := s
- let _use_runtime s = use_runtime := s
- let _v () = print_version_and_library "compiler"
- let _version = print_version_string
- let _vnum = print_version_string
- let _w = (Warnings.parse_options false)
- let _warn_error = (Warnings.parse_options true)
- let _warn_help = Warnings.help_warnings
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
- let _where = print_standard_library
- let _verbose = set verbose
- let _nopervasives = set nopervasives
- let _match_context_rows n = match_context_rows := n
- let _dump_into_file = set dump_into_file
- let _dno_unique_ids = unset unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _dinstr = set dump_instr
- let _dcamlprimc = set keep_camlprimc_file
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
-
- let _args = Arg.read_arg
- let _args0 = Arg.read_arg0
-
- let anonymous = anonymous
-end)
+module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main)
let main () =
Clflags.add_arguments __LOC__ Options.list;
end
else if not !compile_only && !objfiles <> [] then begin
let target =
- if !output_c_object then
+ if !output_c_object && not !output_complete_executable then
let s = extract_output !output_name in
if (Filename.check_suffix s Config.ext_obj
|| Filename.check_suffix s Config.ext_dll
"<dir> Add <dir> to the run-time search path for shared libraries"
;;
+let mk_function_sections f =
+ if Config.function_sections then
+ "-function-sections", Arg.Unit f,
+ " Generate each function in a separate section if target supports it"
+ else
+ let err () =
+ raise (Arg.Bad "OCaml has been configured without support for \
+ -function-sections")
+ in
+ "-function-sections", Arg.Unit err, " (option not available)"
+;;
+
let mk_stop_after f =
"-stop-after", Arg.Symbol (Clflags.Compiler_pass.pass_names, f),
" Stop after the given compilation pass."
" Output an object file, including runtime, instead of an executable"
;;
+let mk_output_complete_exe f =
+ "-output-complete-exe", Arg.Unit f,
+ " Output a self-contained executable, including runtime and C stubs"
+;;
+
let mk_p f =
"-p", Arg.Unit f, " (no longer supported)"
;;
val _noassert : unit -> unit
val _nolabels : unit -> unit
val _nostdlib : unit -> unit
- val _nopervasives : unit -> unit
val _open : string -> unit
val _ppx : string -> unit
val _principal : unit -> unit
val _no_strict_formats : unit -> unit
val _unboxed_types : unit -> unit
val _no_unboxed_types : unit -> unit
- val _unsafe : unit -> unit
val _unsafe_string : unit -> unit
val _version : unit -> unit
val _vnum : unit -> unit
val _w : string -> unit
+
+ val anonymous : string -> unit
+end
+
+module type Core_options = sig
+ include Common_options
+
+ val _nopervasives : unit -> unit
+ val _unsafe : unit -> unit
val _warn_error : string -> unit
val _warn_help : unit -> unit
val _drawlambda : unit -> unit
val _dlambda : unit -> unit
- val anonymous : string -> unit
end
module type Compiler_options = sig
;;
module type Toplevel_options = sig
- include Common_options
+ include Core_options
val _init : string -> unit
val _noinit : unit -> unit
val _no_version : unit -> unit
;;
module type Bytecomp_options = sig
- include Common_options
+ include Core_options
include Compiler_options
val _compat_32 : unit -> unit
val _custom : unit -> unit
val _make_runtime : unit -> unit
val _vmthread : unit -> unit
val _use_runtime : string -> unit
+ val _output_complete_exe : unit -> unit
val _dinstr : unit -> unit
val _dcamlprimc : unit -> unit
val _o3 : unit -> unit
val _insn_sched : unit -> unit
val _no_insn_sched : unit -> unit
+ val _linscan : unit -> unit
+ val _no_float_const_prop : unit -> unit
val _clambda_checks : unit -> unit
val _dflambda : unit -> unit
val _dreload : unit -> unit
val _dscheduling : unit -> unit
val _dlinear : unit -> unit
+ val _dinterval : unit -> unit
val _dstartup : unit -> unit
end;;
module type Optcomp_options = sig
- include Common_options
+ include Core_options
include Compiler_options
include Optcommon_options
- val _linscan : unit -> unit
- val _no_float_const_prop : unit -> unit
val _nodynlink : unit -> unit
val _p : unit -> unit
val _pp : string -> unit
val _shared : unit -> unit
val _afl_instrument : unit -> unit
val _afl_inst_ratio : int -> unit
- val _dinterval : unit -> unit
+ val _function_sections : unit -> unit
end;;
module type Opttop_options = sig
mk_open F._open;
mk_output_obj F._output_obj;
mk_output_complete_obj F._output_complete_obj;
+ mk_output_complete_exe F._output_complete_exe;
mk_pack_byt F._pack;
mk_pp F._pp;
mk_ppx F._ppx;
mk_dtypes F._annot;
mk_for_pack_opt F._for_pack;
mk_g_opt F._g;
+ mk_function_sections F._function_sections;
mk_stop_after F._stop_after;
mk_i F._i;
mk_I F._I;
mk_labels F._labels;
mk_alias_deps F._alias_deps;
mk_no_alias_deps F._no_alias_deps;
+ mk_linscan F._linscan;
mk_app_funct F._app_funct;
mk_no_app_funct F._no_app_funct;
+ mk_no_float_const_prop F._no_float_const_prop;
mk_noassert F._noassert;
mk_noinit F._noinit;
mk_nolabels F._nolabels;
mk_dreload F._dreload;
mk_dscheduling F._dscheduling;
mk_dlinear F._dlinear;
+ mk_dinterval F._dinterval;
mk_dstartup F._dstartup;
mk_dump_pass F._dump_pass;
]
options_with_command_line_syntax_inner r rest
~name_opt:(Some name) spec, doc)
) options
+
+module Default = struct
+ open Clflags
+ open Compenv
+ let set r () = r := true
+ let clear r () = r := false
+
+ module Common = struct
+ let _absname = set Clflags.absname
+ let _alert = Warnings.parse_alert_option
+ let _alias_deps = clear transparent_modules
+ let _app_funct = set applicative_functors
+ let _labels = clear classic
+ let _no_alias_deps = set transparent_modules
+ let _no_app_funct = clear applicative_functors
+ let _no_principal = clear principal
+ let _no_rectypes = clear recursive_types
+ let _no_strict_formats = clear strict_formats
+ let _no_strict_sequence = clear strict_sequence
+ let _no_unboxed_types = clear unboxed_types
+ let _noassert = set noassert
+ let _nolabels = set classic
+ let _nostdlib = set no_std_include
+ let _open s = open_modules := (s :: (!open_modules))
+ let _principal = set principal
+ let _rectypes = set recursive_types
+ let _safe_string = clear unsafe_string
+ let _short_paths = clear real_paths
+ let _strict_formats = set strict_formats
+ let _strict_sequence = set strict_sequence
+ let _unboxed_types = set unboxed_types
+ let _unsafe_string = set unsafe_string
+ let _w s = Warnings.parse_options false s
+
+ let anonymous = anonymous
+
+ end
+
+ module Core = struct
+ include Common
+ let _I dir = include_dirs := (dir :: (!include_dirs))
+ let _color = Misc.set_or_ignore color_reader.parse color
+ let _dlambda = set dump_lambda
+ let _dno_unique_ids = clear unique_ids
+ let _dparsetree = set dump_parsetree
+ let _drawlambda = set dump_rawlambda
+ let _dsource = set dump_source
+ let _dtypedtree = set dump_typedtree
+ let _dunique_ids = set unique_ids
+ let _error_style =
+ Misc.set_or_ignore error_style_reader.parse error_style
+ let _nopervasives = set nopervasives
+ let _ppx s = first_ppx := (s :: (!first_ppx))
+ let _unsafe = set unsafe
+ let _warn_error s = Warnings.parse_options true s
+ let _warn_help = Warnings.help_warnings
+ end
+
+ module Native = struct
+ let _S = set keep_asm_file
+ let _clambda_checks () = clambda_checks := true
+ let _classic_inlining () = classic_inlining := true
+ let _compact = clear optimize_for_speed
+ let _dalloc = set dump_regalloc
+ let _davail () = dump_avail := true
+ let _dclambda = set dump_clambda
+ let _dcmm = set dump_cmm
+ let _dcombine = set dump_combine
+ let _dcse = set dump_cse
+ let _dflambda = set dump_flambda
+ let _dflambda_invariants = set flambda_invariant_checks
+ let _dflambda_let stamp = dump_flambda_let := (Some stamp)
+ let _dflambda_no_invariants = clear flambda_invariant_checks
+ let _dflambda_verbose () =
+ set dump_flambda (); set dump_flambda_verbose ()
+ let _dinterval = set dump_interval
+ let _dinterf = set dump_interf
+ let _dlinear = set dump_linear
+ let _dlive () = dump_live := true
+ let _dprefer = set dump_prefer
+ let _drawclambda = set dump_rawclambda
+ let _drawflambda = set dump_rawflambda
+ let _dreload = set dump_reload
+ let _drunavail () = debug_runavail := true
+ let _dscheduling = set dump_scheduling
+ let _dsel = set dump_selection
+ let _dspill = set dump_spill
+ let _dsplit = set dump_split
+ let _dstartup = set keep_startup_file
+ let _dump_pass pass = set_dumped_pass pass true
+ let _inline spec =
+ Float_arg_helper.parse spec "Syntax: -inline <n> | <round>=<n>[,...]"
+ inline_threshold
+ let _inline_alloc_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-alloc-cost <n> | <round>=<n>[,...]"
+ inline_alloc_cost
+ let _inline_branch_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-branch-cost <n> | <round>=<n>[,...]"
+ inline_branch_cost
+ let _inline_branch_factor spec =
+ Float_arg_helper.parse spec
+ "Syntax: -inline-branch-factor <n> | <round>=<n>[,...]"
+ inline_branch_factor
+ let _inline_call_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-call-cost <n> | <round>=<n>[,...]" inline_call_cost
+ let _inline_indirect_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-indirect-cost <n> | <round>=<n>[,...]"
+ inline_indirect_cost
+ let _inline_lifting_benefit spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-lifting-benefit <n> | <round>=<n>[,...]"
+ inline_lifting_benefit
+ let _inline_max_depth spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-max-depth <n> | <round>=<n>[,...]" inline_max_depth
+ let _inline_max_unroll spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-max-unroll <n> | <round>=<n>[,...]"
+ inline_max_unroll
+ let _inline_prim_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-prim-cost <n> | <round>=<n>[,...]" inline_prim_cost
+ let _inline_toplevel spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-toplevel <n> | <round>=<n>[,...]"
+ inline_toplevel_threshold
+ let _inlining_report () = inlining_report := true
+ let _insn_sched = set insn_sched
+ let _no_insn_sched = clear insn_sched
+ let _linscan = set use_linscan
+ let _no_float_const_prop = clear float_const_prop
+ let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
+ let _no_unbox_specialised_args = clear unbox_specialised_args
+ (* CR-someday mshinwell: should stop e.g. -O2 -classic-inlining
+ lgesbert: could be done in main() below, like for -pack and -c, but that
+ would prevent overriding using OCAMLPARAM.
+ mshinwell: We're going to defer this for the moment and add a note in
+ the manual that the behaviour is unspecified in cases such as this.
+ We should refactor the code so that the user's requirements are
+ collected, then checked all at once for illegal combinations, and then
+ transformed into the settings of the individual parameters.
+ *)
+ let _o2 () =
+ default_simplify_rounds := 2;
+ use_inlining_arguments_set o2_arguments;
+ use_inlining_arguments_set ~round:0 o1_arguments
+ let _o3 () =
+ default_simplify_rounds := 3;
+ use_inlining_arguments_set o3_arguments;
+ use_inlining_arguments_set ~round:1 o2_arguments;
+ use_inlining_arguments_set ~round:0 o1_arguments
+ let _remove_unused_arguments = set remove_unused_arguments
+ let _rounds n = simplify_rounds := (Some n)
+ let _unbox_closures = set unbox_closures
+ let _unbox_closures_factor f = unbox_closures_factor := f
+ let _verbose = set verbose
+ end
+
+ module Compiler = struct
+ let _a = set make_archive
+ let _annot = set annotations
+ let _args = Arg.read_arg
+ let _args0 = Arg.read_arg0
+ let _binannot = set binary_annotations
+ let _c = set compile_only
+ let _cc s = c_compiler := (Some s)
+ let _cclib s = defer (ProcessObjects (Misc.rev_split_words s))
+ let _ccopt s = first_ccopts := (s :: (!first_ccopts))
+ let _config = Misc.show_config_and_exit
+ let _config_var = Misc.show_config_variable_and_exit
+ let _dprofile () = profile_columns := Profile.all_columns
+ let _dtimings () = profile_columns := [`Time]
+ let _dump_into_file = set dump_into_file
+ let _for_pack s = for_package := (Some s)
+ let _g = set debug
+ let _i () =
+ print_types := true;
+ compile_only := true;
+ stop_after := (Some Compiler_pass.Typing);
+ ()
+ let _impl = impl
+ let _intf = intf
+ let _intf_suffix s = Config.interface_suffix := s
+ let _keep_docs = set keep_docs
+ let _keep_locs = set keep_locs
+ let _linkall = set link_everything
+ let _match_context_rows n = match_context_rows := n
+ let _no_keep_docs = clear keep_docs
+ let _no_keep_locs = clear keep_locs
+ let _noautolink = set no_auto_link
+ let _o s = output_name := (Some s)
+ let _opaque = set opaque
+ let _pack = set make_package
+ let _plugin _p = plugin := true
+ let _pp s = preprocessor := (Some s)
+ let _runtime_variant s = runtime_variant := s
+ let _stop_after pass =
+ let module P = Compiler_pass in
+ match P.of_string pass with
+ | None -> () (* this should not occur as we use Arg.Symbol *)
+ | Some pass ->
+ stop_after := (Some pass);
+ match pass with
+ | P.Parsing | P.Typing -> compile_only := true
+ let _thread = set use_threads
+ let _verbose = set verbose
+ let _version () = print_version_string ()
+ let _vnum () = print_version_string ()
+ let _where () = print_standard_library ()
+ let _with_runtime = set with_runtime
+ let _without_runtime = clear with_runtime
+ end
+
+ module Toplevel = struct
+
+ let print_version () =
+ Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
+ exit 0;
+ ;;
+
+ let print_version_num () =
+ Printf.printf "%s\n" Sys.ocaml_version;
+ exit 0;
+ ;;
+
+ let _args (_:string) = (* placeholder: wrap_expand Arg.read_arg *) [||]
+ let _args0 (_:string) = (* placeholder: wrap_expand Arg.read_arg0 *) [||]
+ let _init s = init_file := (Some s)
+ let _no_version = set noversion
+ let _noinit = set noinit
+ let _noprompt = set noprompt
+ let _nopromptcont = set nopromptcont
+ let _stdin () = (* placeholder: file_argument ""*) ()
+ let _version () = print_version ()
+ let _vnum () = print_version_num ()
+ end
+
+ module Topmain = struct
+ include Toplevel
+ include Core
+ let _dinstr = set dump_instr
+ end
+
+ module Opttopmain = struct
+ include Toplevel
+ include Native
+ include Core
+ end
+
+ module Optmain = struct
+ include Native
+ include Core
+ include Compiler
+ let _afl_inst_ratio n = afl_inst_ratio := n
+ let _afl_instrument = set afl_instrument
+ let _function_sections () =
+ assert Config.function_sections;
+ first_ccopts := ("-ffunction-sections" :: (!first_ccopts));
+ function_sections := true
+ let _nodynlink = clear dlcode
+ let _output_complete_obj () =
+ set output_c_object (); set output_complete_object ()
+ let _output_obj = set output_c_object
+ let _p () =
+ fatal
+ "Profiling with \"gprof\" (option `-p') is only supported up to \
+ OCaml 4.08.0"
+ let _shared () = shared := true; dlcode := true
+ let _v () = print_version_and_library "native-code compiler"
+ end
+
+ module Odoc_args = struct
+ include Common
+ let _I(_:string) =
+ (* placeholder:
+ Odoc_global.include_dirs := (s :: (!Odoc_global.include_dirs))
+ *) ()
+ let _impl (_:string) =
+ (* placeholder:
+ Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s])
+ *) ()
+ let _intf (_:string) = (* placeholder:
+ Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Intf_file s])
+ *) ()
+ let _intf_suffix s = Config.interface_suffix := s
+ let _pp s = Clflags.preprocessor := (Some s)
+ let _ppx s = Clflags.all_ppx := (s :: (!Clflags.all_ppx))
+ let _thread = set Clflags.use_threads
+ let _v () = Compenv.print_version_and_library "documentation generator"
+ let _verbose = set Clflags.verbose
+ let _version = Compenv.print_version_string
+ let _vmthread = ignore
+ let _vnum = Compenv.print_version_string
+ end
+
+ module Main = struct
+
+ let vmthread_removed_message = "\
+The -vmthread argument of ocamlc is no longer supported\n\
+since OCaml 4.09.0. Please switch to system threads, which have the\n\
+same API. Lightweight threads with VM-level scheduling are provided by\n\
+third-party libraries such as Lwt, but with a different API."
+
+ include Core
+ include Compiler
+ let _compat_32 = set bytecode_compatible_32
+ let _custom = set custom_runtime
+ let _dcamlprimc = set keep_camlprimc_file
+ let _dinstr = set dump_instr
+ let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s))
+ let _dllpath s = dllpaths := ((!dllpaths) @ [s])
+ let _make_runtime () =
+ custom_runtime := true; make_runtime := true; link_everything := true
+ let _no_check_prims = set no_check_prims
+ let _output_complete_obj () =
+ output_c_object := true;
+ output_complete_object := true;
+ custom_runtime := true
+ let _output_complete_exe () =
+ _output_complete_obj (); output_complete_executable := true
+ let _output_obj () = output_c_object := true; custom_runtime := true
+ let _use_prims s = use_prims := s
+ let _use_runtime s = use_runtime := s
+ let _v () = print_version_and_library "compiler"
+ let _vmthread () = fatal vmthread_removed_message
+ end
+
+end
val _noassert : unit -> unit
val _nolabels : unit -> unit
val _nostdlib : unit -> unit
- val _nopervasives : unit -> unit
val _open : string -> unit
val _ppx : string -> unit
val _principal : unit -> unit
val _no_strict_formats : unit -> unit
val _unboxed_types : unit -> unit
val _no_unboxed_types : unit -> unit
- val _unsafe : unit -> unit
val _unsafe_string : unit -> unit
val _version : unit -> unit
val _vnum : unit -> unit
val _w : string -> unit
+
+ val anonymous : string -> unit
+end
+
+module type Core_options = sig
+ include Common_options
+
+ val _nopervasives : unit -> unit
+ val _unsafe : unit -> unit
val _warn_error : string -> unit
val _warn_help : unit -> unit
val _drawlambda : unit -> unit
val _dlambda : unit -> unit
- val anonymous : string -> unit
-end;;
+end
module type Compiler_options = sig
val _a : unit -> unit
;;
module type Toplevel_options = sig
- include Common_options
+ include Core_options
val _init : string -> unit
val _noinit : unit -> unit
val _no_version : unit -> unit
val _noprompt : unit -> unit
val _nopromptcont : unit -> unit
val _stdin : unit -> unit
- val _args: string -> string array
- val _args0: string -> string array
+ val _args : string -> string array
+ val _args0 : string -> string array
val _color : string -> unit
val _error_style : string -> unit
-
end
;;
module type Bytecomp_options = sig
- include Common_options
+ include Core_options
include Compiler_options
val _compat_32 : unit -> unit
val _custom : unit -> unit
val _make_runtime : unit -> unit
val _vmthread : unit -> unit
val _use_runtime : string -> unit
+ val _output_complete_exe : unit -> unit
val _dinstr : unit -> unit
val _dcamlprimc : unit -> unit
module type Bytetop_options = sig
include Toplevel_options
val _dinstr : unit -> unit
+
end;;
module type Optcommon_options = sig
val _o3 : unit -> unit
val _insn_sched : unit -> unit
val _no_insn_sched : unit -> unit
+ val _linscan : unit -> unit
+ val _no_float_const_prop : unit -> unit
val _clambda_checks : unit -> unit
val _dflambda : unit -> unit
val _dreload : unit -> unit
val _dscheduling : unit -> unit
val _dlinear : unit -> unit
+ val _dinterval : unit -> unit
val _dstartup : unit -> unit
end;;
module type Optcomp_options = sig
- include Common_options
+ include Core_options
include Compiler_options
include Optcommon_options
- val _linscan : unit -> unit
- val _no_float_const_prop : unit -> unit
val _nodynlink : unit -> unit
val _p : unit -> unit
val _pp : string -> unit
val _shared : unit -> unit
val _afl_instrument : unit -> unit
val _afl_inst_ratio : int -> unit
- val _dinterval : unit -> unit
+ val _function_sections : unit -> unit
end;;
module type Opttop_options = sig
val _v : unit -> unit
val _verbose : unit -> unit
val _vmthread : unit -> unit
-end;;
+end
module type Arg_list = sig
val list : (string * Arg.spec * string) list
end;;
-module Make_bytecomp_options (F : Bytecomp_options) : Arg_list;;
-module Make_bytetop_options (F : Bytetop_options) : Arg_list;;
-module Make_optcomp_options (F : Optcomp_options) : Arg_list;;
-module Make_opttop_options (F : Opttop_options) : Arg_list;;
-module Make_ocamldoc_options (F : Ocamldoc_options) : Arg_list;;
+module Make_bytecomp_options : Bytecomp_options -> Arg_list;;
+module Make_bytetop_options : Bytetop_options -> Arg_list;;
+module Make_optcomp_options : Optcomp_options -> Arg_list;;
+module Make_opttop_options : Opttop_options -> Arg_list;;
+module Make_ocamldoc_options : Ocamldoc_options -> Arg_list;;
(** [options_with_command_line_syntax options r] returns [options2] that behaves
like [options], but additionally pushes command line argument on [r] (quoted
: (string * Arg.spec * string) list
-> string list ref
-> (string * Arg.spec * string) list
+
+module Default: sig
+ module Topmain: Bytetop_options
+ module Opttopmain: Opttop_options
+ module Main: Bytecomp_options
+ module Optmain: Optcomp_options
+ module Odoc_args: Ocamldoc_options
+end
"-all", Arg.Set all_dependencies,
" Generate dependencies on all files";
"-allow-approx", Arg.Set allow_approximation,
- " Fallback to a lexer-based approximation on unparseable files";
+ " Fallback to a lexer-based approximation on unparsable files";
"-as-map", Arg.Set Clflags.transparent_modules,
" Omit delayed dependencies for module aliases (-no-alias-deps -w -49)";
(* "compiler uses -no-alias-deps, and no module is coerced"; *)
+++ /dev/null
-#!/bin/sh
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Jacques Garrigue, Kyoto University RIMS *
-#* *
-#* Copyright 2002 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-topdir=`dirname $0`
-
-exec @compiler@ -nostdlib -I $topdir/stdlib "$@"
|>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
|>> Simplif.simplify_lambda
|>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
- |> (fun ((module_ident, size), lam) ->
- Flambda_middle_end.middle_end
- ~ppf_dump:i.ppf_dump
- ~prefixname:i.output_prefix
- ~size
- ~filename:i.source_file
- ~module_ident
+ |> (fun ((module_ident, main_module_block_size), code) ->
+ let program : Lambda.program =
+ { Lambda.
+ module_ident;
+ main_module_block_size;
+ required_globals;
+ code;
+ }
+ in
+ Asmgen.compile_implementation
~backend
- ~module_initializer:lam)
- |> Asmgen.compile_implementation_flambda
- i.output_prefix ~required_globals ~backend ~ppf_dump:i.ppf_dump;
+ ~filename:i.source_file
+ ~prefixname:i.output_prefix
+ ~middle_end:Flambda_middle_end.lambda_to_clambda
+ ~ppf_dump:i.ppf_dump
+ program);
Compilenv.save_unit_info (cmx i))
let clambda i backend typed =
let code = Simplif.simplify_lambda program.Lambda.code in
{ program with Lambda.code }
|> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program
- |> Asmgen.compile_implementation_clambda
- i.output_prefix ~backend ~ppf_dump:i.ppf_dump;
+ |> Asmgen.compile_implementation
+ ~backend
+ ~filename:i.source_file
+ ~prefixname:i.output_prefix
+ ~middle_end:Closure_middle_end.lambda_to_clambda
+ ~ppf_dump:i.ppf_dump;
Compilenv.save_unit_info (cmx i))
let implementation ~backend ~source_file ~output_prefix =
let usage = "Usage: ocamlopt <options> <files>\nOptions are:"
-module Options = Main_args.Make_optcomp_options (struct
- let set r () = r := true
- let clear r () = r := false
-
- let _a = set make_archive
- let _absname = set Clflags.absname
- let _afl_instrument = set afl_instrument
- let _afl_inst_ratio n = afl_inst_ratio := n
- let _alert = Warnings.parse_alert_option
- let _annot = set annotations
- let _binannot = set binary_annotations
- let _c = set compile_only
- let _cc s = c_compiler := Some s
- let _cclib s = defer (ProcessObjects (Misc.rev_split_words s))
- let _ccopt s = first_ccopts := s :: !first_ccopts
- let _clambda_checks () = clambda_checks := true
- let _compact = clear optimize_for_speed
- let _config = Misc.show_config_and_exit
- let _config_var = Misc.show_config_variable_and_exit
- let _for_pack s = for_package := Some s
- let _g = set debug
- let _i () =
- print_types := true;
- compile_only := true;
- stop_after := Some Compiler_pass.Typing;
- ()
- let _stop_after pass =
- let module P = Compiler_pass in
- begin match P.of_string pass with
- | None -> () (* this should not occur as we use Arg.Symbol *)
- | Some pass ->
- stop_after := Some pass;
- begin match pass with
- | P.Parsing | P.Typing ->
- compile_only := true
- end;
- end
- let _I dir = include_dirs := dir :: !include_dirs
- let _impl = impl
- let _inline spec =
- Float_arg_helper.parse spec
- "Syntax: -inline <n> | <round>=<n>[,...]" inline_threshold
- let _inline_toplevel spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-toplevel <n> | <round>=<n>[,...]"
- inline_toplevel_threshold
- let _inlining_report () = inlining_report := true
- let _dump_pass pass = set_dumped_pass pass true
- let _rounds n = simplify_rounds := Some n
- let _inline_max_unroll spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-unroll <n> | <round>=<n>[,...]"
- inline_max_unroll
- let _classic_inlining () = classic_inlining := true
- let _inline_call_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-call-cost <n> | <round>=<n>[,...]"
- inline_call_cost
- let _inline_alloc_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-alloc-cost <n> | <round>=<n>[,...]"
- inline_alloc_cost
- let _inline_prim_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-prim-cost <n> | <round>=<n>[,...]"
- inline_prim_cost
- let _inline_branch_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-branch-cost <n> | <round>=<n>[,...]"
- inline_branch_cost
- let _inline_indirect_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-indirect-cost <n> | <round>=<n>[,...]"
- inline_indirect_cost
- let _inline_lifting_benefit spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-lifting-benefit <n> | <round>=<n>[,...]"
- inline_lifting_benefit
- let _inline_branch_factor spec =
- Float_arg_helper.parse spec
- "Syntax: -inline-branch-factor <n> | <round>=<n>[,...]"
- inline_branch_factor
- let _intf_suffix s = Config.interface_suffix := s
- let _insn_sched = set insn_sched
- let _intf = intf
- let _keep_docs = set keep_docs
- let _no_keep_docs = clear keep_docs
- let _keep_locs = set keep_locs
- let _no_keep_locs = clear keep_locs
- let _labels = clear classic
- let _linkall = set link_everything
- let _inline_max_depth spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-depth <n> | <round>=<n>[,...]"
- inline_max_depth
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _linscan = set use_linscan
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _no_float_const_prop = clear float_const_prop
- let _noassert = set noassert
- let _noautolink = set no_auto_link
- let _nodynlink = clear dlcode
- let _no_insn_sched = clear insn_sched
- let _nolabels = set classic
- let _nostdlib = set no_std_include
- let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
- let _no_unbox_specialised_args = clear unbox_specialised_args
- let _o s = output_name := Some s
- (* CR-someday mshinwell: should stop e.g. -O2 -classic-inlining
- lgesbert: could be done in main() below, like for -pack and -c, but that
- would prevent overriding using OCAMLPARAM.
- mshinwell: We're going to defer this for the moment and add a note in
- the manual that the behaviour is unspecified in cases such as this.
- We should refactor the code so that the user's requirements are
- collected, then checked all at once for illegal combinations, and then
- transformed into the settings of the individual parameters.
- *)
- let _o2 () =
- default_simplify_rounds := 2;
- use_inlining_arguments_set o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _o3 () =
- default_simplify_rounds := 3;
- use_inlining_arguments_set o3_arguments;
- use_inlining_arguments_set ~round:1 o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _open s = open_modules := s :: !open_modules
- let _output_obj = set output_c_object
- let _output_complete_obj () =
- set output_c_object (); set output_complete_object ()
- let _p () =
- fatal "Profiling with \"gprof\" (option `-p') is only supported up \
- to OCaml 4.08.0"
- let _pack = set make_package
- let _plugin _p = plugin := true
- let _pp s = preprocessor := Some s
- let _ppx s = first_ppx := s :: !first_ppx
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _remove_unused_arguments = set remove_unused_arguments
- let _runtime_variant s = runtime_variant := s
- let _with_runtime = set with_runtime
- let _without_runtime = clear with_runtime
- let _safe_string = clear unsafe_string
- let _short_paths = clear real_paths
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _shared () = shared := true; dlcode := true
- let _S = set keep_asm_file
- let _thread = set use_threads
- let _unbox_closures = set unbox_closures
- let _unbox_closures_factor f = unbox_closures_factor := f
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _v () = print_version_and_library "native-code compiler"
- let _version () = print_version_string ()
- let _vnum () = print_version_string ()
- let _verbose = set verbose
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
- let _where () = print_standard_library ()
- let _nopervasives = set nopervasives
- let _match_context_rows n = match_context_rows := n
- let _dump_into_file = set dump_into_file
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _drawclambda = set dump_rawclambda
- let _dclambda = set dump_clambda
- let _drawflambda = set dump_rawflambda
- let _dflambda = set dump_flambda
- let _dflambda_let stamp = dump_flambda_let := Some stamp
- let _dflambda_verbose () =
- set dump_flambda ();
- set dump_flambda_verbose ()
- let _dflambda_invariants = set flambda_invariant_checks
- let _dflambda_no_invariants = clear flambda_invariant_checks
- let _dcmm = set dump_cmm
- let _dsel = set dump_selection
- let _dcombine = set dump_combine
- let _dcse = set dump_cse
- let _dlive () = dump_live := true; Printmach.print_live := true
- let _davail () = dump_avail := true
- let _drunavail () = debug_runavail := true
- let _dspill = set dump_spill
- let _dsplit = set dump_split
- let _dinterf = set dump_interf
- let _dprefer = set dump_prefer
- let _dalloc = set dump_regalloc
- let _dreload = set dump_reload
- let _dscheduling = set dump_scheduling
- let _dlinear = set dump_linear
- let _dinterval = set dump_interval
- let _dstartup = set keep_startup_file
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
- let _opaque = set opaque
-
- let _args = Arg.read_arg
- let _args0 = Arg.read_arg0
-
- let anonymous = anonymous
-end);;
-
+module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain)
let main () =
native_code := true;
let ppf = Format.err_formatter in
;**************************************************************************
(env
- (dev (flags (:standard -w +a-4-9-41-42-44-45-48)))
- (release (flags (:standard -w +a-4-9-41-42-44-45-48))))
+ (dev (flags (:standard -w +a-4-9-40-41-42-44-45-48)))
+ (release (flags (:standard -w +a-4-9-40-41-42-44-45-48))))
;; Too annoying to get to work. Use (copy_files# ...) instead
; (include_subdirs unqualified)
;; TYPING
ident path primitive types btype oprint subst predef datarepr
- cmi_format persistent_env env
+ cmi_format persistent_env env type_immediacy
typedtree printtyped ctype printtyp includeclass mtype envaux includecore
tast_iterator tast_mapper cmt_format untypeast includemod
typetexp printpat parmatch stypes typedecl typeopt rec_check typecore
symbol variable
;; middle_end/closure/
- closure
+ closure closure_middle_end
;; middle_end/flambda/base_types/
closure_element closure_id closure_origin export_id id_types mutable_variable
(modules
;; asmcomp/
afl_instrument arch asmgen asmlibrarian asmlink asmpackager branch_relaxation
- branch_relaxation_intf cmm cmmgen cmmgen_state coloring comballoc CSE CSEgen
- deadcode emit emitaux interf interval linearize linscan liveness mach
- printcmm printlinear printmach proc reg reload reloadgen schedgen scheduling
- selectgen selection spacetime_profiling spill split strmatch x86_ast
- x86_dsl x86_gas x86_masm x86_proc
+ branch_relaxation_intf cmm_helpers cmm cmmgen cmmgen_state coloring comballoc
+ CSE CSEgen
+ deadcode domainstate emit emitaux interf interval linear linearize linscan
+ liveness mach printcmm printlinear printmach proc reg reload reloadgen
+ schedgen scheduling selectgen selection spacetime_profiling spill split
+ strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc
;; asmcomp/debug/
reg_availability_set compute_ranges_intf available_regs reg_with_debug_info
toplevel/ocaml.byte
toplevel/expunge.exe
))
+
+(alias
+ (name libs)
+ (deps
+ ocamloptcomp.cma
+ ocamlmiddleend.cma
+ ocamlcommon.cma
+ runtime/runtime.cma
+ stdlib/stdlib.cma
+ ocamlbytecomp.cma
+ ocamltest/ocamltest_core_and_plugin.cma
+ toplevel/ocamltoplevel.cma
+ ))
| None -> None
| Some cmi -> Some (output_cmi temp_file_name oc cmi)
in
- let source_digest = Misc.may_map Digest.file sourcefile in
+ let source_digest = Option.map Digest.file sourcefile in
let cmt = {
cmt_modname = modname;
cmt_annots = clear_env binary_annots;
--- /dev/null
+profile=conventional
+if-then-else=k-r
+indicate-multiline-delimiters=closing-on-separate-line
+break-cases=all
+disable=true
--- /dev/null
+matching.ml
#**************************************************************************
echo 'let builtin_exceptions = [|'
-cat "$1" | tr -d '\r' | \
- sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p'
+tr -d '\r' < "$1" | sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p'
echo '|]'
echo 'let builtin_primitives = [|'
let pers = Ident.create_persistent mod_name in
let env = Env.add_persistent_structure pers Env.empty in
let lid = Longident.Ldot (Longident.Lident mod_name, name) in
- match Env.lookup_value lid env with
+ match Env.find_value_by_name lid env with
| path, _ -> transl_value_path Location.none env path
| exception Not_found ->
fatal_error ("Primitive " ^ name ^ " not found.")
let remove_list l s =
List.fold_left (fun s (id, _kind) -> Ident.Map.remove id s) s l
in
- let module M = Ident.Map in
match lam with
| Lvar id as l ->
begin try Ident.Map.find id s with Not_found -> l end
sw_consts = List.map (fun (n, e) -> (n, f e)) sw.sw_consts;
sw_numblocks = sw.sw_numblocks;
sw_blocks = List.map (fun (n, e) -> (n, f e)) sw.sw_blocks;
- sw_failaction = Misc.may_map f sw.sw_failaction;
+ sw_failaction = Option.map f sw.sw_failaction;
},
loc)
| Lstringswitch (e, sw, default, loc) ->
Lstringswitch (
f e,
List.map (fun (s, e) -> (s, f e)) sw,
- Misc.may_map f default,
+ Option.map f default,
loc)
| Lstaticraise (i, args) ->
Lstaticraise (i, List.map f args)
| Lstaticraise of int * lambda list
| Lstaticcatch of lambda * (int * (Ident.t * value_kind) list) * lambda
| Ltrywith of lambda * Ident.t * lambda
+(* Lifthenelse (e, t, f) evaluates t if e evaluates to 0, and
+ evaluates f if e evaluates to any other value *)
| Lifthenelse of lambda * lambda * lambda
| Lsequence of lambda * lambda
| Lwhile of lambda * lambda
(* *)
(**************************************************************************)
-(* Compilation of pattern matching *)
+(* Compilation of pattern matching
+
+ Based upon Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001.
+
+ A previous version was based on Peyton-Jones, ``The Implementation of
+ functional programming languages'', chapter 5.
+
+
+ Overview of the implementation
+ ==============================
+
+ 1. Precompilation
+ -----------------
+
+ (split_and_precompile)
+ We first split the initial pattern matching (or "pm") along its first column
+ -- simplifying pattern heads in the process --, so that we obtain an ordered
+ list of pms.
+ For every pm in this list, and any two patterns in its first column, either
+ the patterns have the same head, or their heads match disjoint sets of
+ values. (In particular, two extension constructors that may or may not be
+ equal due to hidden rebinding cannot occur in the same simple pm.)
+
+ 2. Compilation
+ --------------
+
+ The compilation of one of these pms obtained after precompiling is done as
+ follows:
+
+ (divide)
+ We split the match along the first column again, this time grouping rows
+ which start with the same head, and removing the first column.
+ As a result we get a "division", which is a list a "cells" of the form:
+ discriminating pattern head * specialized pm
+
+ (compile_list + compile_match)
+ We then map over the division to compile each cell: we simply restart the
+ whole process on the second element of each cell.
+ Each cell is now of the form:
+ discriminating pattern head * lambda
+
+ (combine_constant, combine_construct, combine_array, ...)
+ We recombine the cells using a switch or some ifs, and if the matching can
+ fail, introduce a jump to the next pm that could potentially match the
+ scrutiny.
+
+ 3. Chaining of pms
+ ------------------
+
+ (comp_match_handlers)
+ Once the pms have been compiled, we stitch them back together in the order
+ produced by precompilation, resulting in the following structure:
+ {v
+ catch
+ catch
+ <first body>
+ with <exit i> ->
+ <second body>
+ with <exit j> ->
+ <third body>
+ v}
+
+ Additionally, bodies whose corresponding exit-number is never used are
+ discarded. So for instance, if in the pseudo-example above we know that exit
+ [i] is never taken, we would actually generate:
+ {v
+ catch
+ <first body>
+ with <exit j> ->
+ <third body>
+ v}
+
+*)
open Misc
open Asttypes
open Printf
open Printpat
-
let dbg = false
-(* See Peyton-Jones, ``The Implementation of functional programming
- languages'', chapter 5. *)
-(*
- Well, it was true at the beginning of the world.
- Now, see Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001
-*)
-
(*
Compatibility predicate that considers potential rebindings of constructors
of an extension type.
returns true when they may have a common instance.
*)
-module MayCompat =
- Parmatch.Compat (struct let equal = Types.may_equal_constr end)
+module MayCompat = Parmatch.Compat (struct
+ let equal = Types.may_equal_constr
+end)
+
let may_compat = MayCompat.compat
+
and may_compats = MayCompat.compats
(*
- Jump summaries: mapping from exit numbers to contexts
*)
-
let string_of_lam lam =
- Printlambda.lambda Format.str_formatter lam ;
+ Printlambda.lambda Format.str_formatter lam;
Format.flush_str_formatter ()
-let all_record_args lbls = match lbls with
-| (_,{lbl_all=lbl_all},_)::_ ->
- let t =
- Array.map
- (fun lbl -> mknoloc (Longident.Lident "?temp?"), lbl,omega)
- lbl_all in
- List.iter
- (fun ((_, lbl,_) as x) -> t.(lbl.lbl_pos) <- x)
- lbls ;
- Array.to_list t
-| _ -> fatal_error "Parmatch.all_record_args"
+let all_record_args lbls =
+ match lbls with
+ | (_, { lbl_all }, _) :: _ ->
+ let t =
+ Array.map
+ (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega))
+ lbl_all
+ in
+ List.iter (fun ((_, lbl, _) as x) -> t.(lbl.lbl_pos) <- x) lbls;
+ Array.to_list t
+ | _ -> fatal_error "Matching.all_record_args"
type matrix = pattern list list
-let add_omega_column pss = List.map (fun ps -> omega::ps) pss
+let add_omega_column pss = List.map (fun ps -> omega :: ps) pss
-type ctx = {left:pattern list ; right:pattern list}
+let rec rev_split_at n ps =
+ if n <= 0 then
+ ([], ps)
+ else
+ match ps with
+ | p :: rem ->
+ let left, right = rev_split_at (n - 1) rem in
+ (p :: left, right)
+ | _ -> assert false
-let pretty_ctx ctx =
- List.iter
- (fun {left=left ; right=right} ->
- Format.eprintf "LEFT:%a RIGHT:%a\n" pretty_line left pretty_line right)
- ctx
-
-let le_ctx c1 c2 =
- le_pats c1.left c2.left &&
- le_pats c1.right c2.right
-
-let lshift {left=left ; right=right} = match right with
-| x::xs -> {left=x::left ; right=xs}
-| _ -> assert false
-
-let lforget {left=left ; right=right} = match right with
-| _::xs -> {left=omega::left ; right=xs}
-| _ -> assert false
-
-let rec small_enough n = function
- | [] -> true
- | _::rem ->
- if n <= 0 then false
- else small_enough (n-1) rem
-
-let ctx_lshift ctx =
- if small_enough (!Clflags.match_context_rows - 1) ctx then
- List.map lshift ctx
- else (* Context pruning *) begin
- get_mins le_ctx (List.map lforget ctx)
- end
+exception NoMatch
-let rshift {left=left ; right=right} = match left with
-| p::ps -> {left=ps ; right=p::right}
-| _ -> assert false
+let ncols = function
+ | [] -> 0
+ | ps :: _ -> List.length ps
-let ctx_rshift ctx = List.map rshift ctx
+module Context : sig
+ type t
-let rec nchars n ps =
- if n <= 0 then [],ps
- else match ps with
- | p::rem ->
- let chars, cdrs = nchars (n-1) rem in
- p::chars,cdrs
- | _ -> assert false
+ val empty : t
+
+ val is_empty : t -> bool
+
+ val start : int -> t
+
+ val eprintf : t -> unit
+
+ val specialize : pattern -> t -> t
+
+ val lshift : t -> t
+
+ val rshift : t -> t
+
+ val rshift_num : int -> t -> t
+
+ val lub : pattern -> t -> t
+
+ val matches : t -> matrix -> bool
+
+ val combine : t -> t
+
+ val select_columns : matrix -> t -> t
+
+ val union : t -> t -> t
+end = struct
+ module Row = struct
+ type t = { left : pattern list; right : pattern list }
+
+ let eprintf { left; right } =
+ Format.eprintf "LEFT:%a RIGHT:%a\n" pretty_line left pretty_line right
+
+ let le c1 c2 = le_pats c1.left c2.left && le_pats c1.right c2.right
-let rshift_num n {left=left ; right=right} =
- let shifted,left = nchars n left in
- {left=left ; right = shifted@right}
+ let lshift { left; right } =
+ match right with
+ | x :: xs -> { left = x :: left; right = xs }
+ | _ -> assert false
+
+ let lforget { left; right } =
+ match right with
+ | _ :: xs -> { left = omega :: left; right = xs }
+ | _ -> assert false
-let ctx_rshift_num n ctx = List.map (rshift_num n) ctx
+ let rshift { left; right } =
+ match left with
+ | p :: ps -> { left = ps; right = p :: right }
+ | _ -> assert false
-(* Recombination of contexts (eg: (_,_)::p1::p2::rem -> (p1,p2)::rem)
+ let rshift_num n { left; right } =
+ let shifted, left = rev_split_at n left in
+ { left; right = shifted @ right }
+
+ (** Recombination of contexts (eg: (_,_)::p1::p2::rem -> (p1,p2)::rem)
All mutable fields are replaced by '_', since side-effects in
guards can alter these fields *)
+ let combine { left; right } =
+ match left with
+ | p :: ps -> { left = ps; right = set_args_erase_mutable p right }
+ | _ -> assert false
+ end
-let combine {left=left ; right=right} = match left with
-| p::ps -> {left=ps ; right=set_args_erase_mutable p right}
-| _ -> assert false
+ type t = Row.t list
-let ctx_combine ctx = List.map combine ctx
+ let empty = []
-let ncols = function
- | [] -> 0
- | ps::_ -> List.length ps
+ let start n : t = [ { left = []; right = omegas n } ]
+ let is_empty = function
+ | [] -> true
+ | _ -> false
-exception NoMatch
-exception OrPat
+ let eprintf ctx = List.iter Row.eprintf ctx
-let filter_matrix matcher pss =
-
- let rec filter_rec = function
- | (p::ps)::rem ->
- begin match p.pat_desc with
- | Tpat_alias (p,_,_) ->
- filter_rec ((p::ps)::rem)
- | Tpat_var _ ->
- filter_rec ((omega::ps)::rem)
- | _ ->
- begin
+ let lshift ctx =
+ if List.length ctx < !Clflags.match_context_rows then
+ List.map Row.lshift ctx
+ else
+ (* Context pruning *)
+ get_mins Row.le (List.map Row.lforget ctx)
+
+ let rshift ctx = List.map Row.rshift ctx
+
+ let rshift_num n ctx = List.map (Row.rshift_num n) ctx
+
+ let combine ctx = List.map Row.combine ctx
+
+ let ctx_matcher p =
+ let p = normalize_pat p in
+ match p.pat_desc with
+ | Tpat_construct (_, cstr, omegas) -> (
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_construct (_, cstr', args)
+ (* NB: may_constr_equal considers (potential) constructor rebinding *)
+ when Types.may_equal_constr cstr cstr' ->
+ (p, args @ rem)
+ | Tpat_any -> (p, omegas @ rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_constant cst -> (
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_constant cst' when const_compare cst cst' = 0 -> (p, rem)
+ | Tpat_any -> (p, rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_variant (lab, Some omega, _) -> (
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_variant (lab', Some arg, _) when lab = lab' -> (p, arg :: rem)
+ | Tpat_any -> (p, omega :: rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_variant (lab, None, _) -> (
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_variant (lab', None, _) when lab = lab' -> (p, rem)
+ | Tpat_any -> (p, rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_array omegas -> (
+ let len = List.length omegas in
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_array args when List.length args = len -> (p, args @ rem)
+ | Tpat_any -> (p, omegas @ rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_tuple omegas -> (
+ let len = List.length omegas in
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_tuple args when List.length args = len -> (p, args @ rem)
+ | Tpat_any -> (p, omegas @ rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_record (((_, lbl, _) :: _ as l), _) -> (
+ (* Records are normalized *)
+ let len = Array.length lbl.lbl_all in
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_record (((_, lbl', _) :: _ as l'), _)
+ when Array.length lbl'.lbl_all = len ->
+ let l' = all_record_args l' in
+ (p, List.fold_right (fun (_, _, p) r -> p :: r) l' rem)
+ | Tpat_any -> (p, List.fold_right (fun (_, _, p) r -> p :: r) l rem)
+ | _ -> raise NoMatch
+ )
+ | Tpat_lazy omega -> (
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_lazy arg -> (p, arg :: rem)
+ | Tpat_any -> (p, omega :: rem)
+ | _ -> raise NoMatch
+ )
+ | _ -> fatal_error "Matching.Context.matcher"
+
+ let specialize q ctx =
+ let matcher = ctx_matcher q in
+ let rec filter_rec : t -> t = function
+ | ({ right = p :: ps } as l) :: rem -> (
+ match p.pat_desc with
+ | Tpat_or (p1, p2, _) ->
+ filter_rec
+ ({ l with right = p1 :: ps }
+ :: { l with
+ Row.right (* disam not principal, OK *) = p2 :: ps
+ }
+ :: rem
+ )
+ | Tpat_alias (p, _, _) ->
+ filter_rec ({ l with right = p :: ps } :: rem)
+ | Tpat_var _ -> filter_rec ({ l with right = omega :: ps } :: rem)
+ | _ -> (
let rem = filter_rec rem in
try
- matcher p ps::rem
- with
- | NoMatch -> rem
- | OrPat ->
- match p.pat_desc with
- | Tpat_or (p1,p2,_) -> filter_rec [(p1::ps) ;(p2::ps)]@rem
- | _ -> assert false
- end
- end
- | [] -> []
- | _ ->
- pretty_matrix Format.err_formatter pss ;
- fatal_error "Matching.filter_matrix" in
- filter_rec pss
+ let to_left, right = matcher p ps in
+ { left = to_left :: l.left; right } :: rem
+ with NoMatch -> rem
+ )
+ )
+ | [] -> []
+ | _ -> fatal_error "Matching.Context.specialize"
+ in
+ filter_rec ctx
+
+ let select_columns pss ctx =
+ let n = ncols pss in
+ let lub_row ps { Row.left; right } =
+ let transfer, right = rev_split_at n right in
+ match lubs transfer ps with
+ | exception Empty -> None
+ | inter -> Some { Row.left = inter @ left; right }
+ in
+ let lub_with_ctx ps = List.filter_map (lub_row ps) ctx in
+ List.flatten (List.map lub_with_ctx pss)
+
+ let lub p ctx =
+ List.filter_map
+ (fun { Row.left; right } ->
+ match right with
+ | q :: rem -> (
+ try Some { Row.left; right = lub p q :: rem } with Empty -> None
+ )
+ | _ -> fatal_error "Matching.Context.lub")
+ ctx
+
+ let matches ctx pss =
+ List.exists
+ (fun { Row.right = qs } -> List.exists (fun ps -> may_compats qs ps) pss)
+ ctx
-let make_default matcher env =
- let rec make_rec = function
- | [] -> []
- | ([[]],i)::_ -> [[[]],i]
- | (pss,i)::rem ->
- let rem = make_rec rem in
- match filter_matrix matcher pss with
- | [] -> rem
- | ([]::_) -> ([[]],i)::rem
- | pss -> (pss,i)::rem in
- make_rec env
-
-let ctx_matcher p =
- let p = normalize_pat p in
- match p.pat_desc with
- | Tpat_construct (_, cstr,omegas) ->
- (fun q rem -> match q.pat_desc with
- | Tpat_construct (_, cstr',args)
-(* NB: may_constr_equal considers (potential) constructor rebinding *)
- when Types.may_equal_constr cstr cstr' ->
- p,args@rem
- | Tpat_any -> p,omegas @ rem
- | _ -> raise NoMatch)
- | Tpat_constant cst ->
- (fun q rem -> match q.pat_desc with
- | Tpat_constant cst' when const_compare cst cst' = 0 ->
- p,rem
- | Tpat_any -> p,rem
- | _ -> raise NoMatch)
- | Tpat_variant (lab,Some omega,_) ->
- (fun q rem -> match q.pat_desc with
- | Tpat_variant (lab',Some arg,_) when lab=lab' ->
- p,arg::rem
- | Tpat_any -> p,omega::rem
- | _ -> raise NoMatch)
- | Tpat_variant (lab,None,_) ->
- (fun q rem -> match q.pat_desc with
- | Tpat_variant (lab',None,_) when lab=lab' ->
- p,rem
- | Tpat_any -> p,rem
- | _ -> raise NoMatch)
- | Tpat_array omegas ->
- let len = List.length omegas in
- (fun q rem -> match q.pat_desc with
- | Tpat_array args when List.length args = len -> p,args @ rem
- | Tpat_any -> p, omegas @ rem
- | _ -> raise NoMatch)
- | Tpat_tuple omegas ->
- let len = List.length omegas in
- (fun q rem -> match q.pat_desc with
- | Tpat_tuple args when List.length args = len -> p,args @ rem
- | Tpat_any -> p, omegas @ rem
- | _ -> raise NoMatch)
- | Tpat_record (((_, lbl, _) :: _) as l,_) -> (* Records are normalized *)
- let len = Array.length lbl.lbl_all in
- (fun q rem -> match q.pat_desc with
- | Tpat_record (((_, lbl', _) :: _) as l',_)
- when Array.length lbl'.lbl_all = len ->
- let l' = all_record_args l' in
- p, List.fold_right (fun (_, _,p) r -> p::r) l' rem
- | Tpat_any -> p,List.fold_right (fun (_, _,p) r -> p::r) l rem
- | _ -> raise NoMatch)
- | Tpat_lazy omega ->
- (fun q rem -> match q.pat_desc with
- | Tpat_lazy arg -> p, (arg::rem)
- | Tpat_any -> p, (omega::rem)
- | _ -> raise NoMatch)
- | _ -> fatal_error "Matching.ctx_matcher"
-
-
-
-
-let filter_ctx q ctx =
-
- let matcher = ctx_matcher q in
-
- let rec filter_rec = function
- | ({right=p::ps} as l)::rem ->
- begin match p.pat_desc with
- | Tpat_or (p1,p2,_) ->
- filter_rec ({l with right=p1::ps}::{l with right=p2::ps}::rem)
- | Tpat_alias (p,_,_) ->
- filter_rec ({l with right=p::ps}::rem)
- | Tpat_var _ ->
- filter_rec ({l with right=omega::ps}::rem)
- | _ ->
- begin let rem = filter_rec rem in
- try
- let to_left, right = matcher p ps in
- {left=to_left::l.left ; right=right}::rem
- with
- | NoMatch -> rem
- end
- end
- | [] -> []
- | _ -> fatal_error "Matching.filter_ctx" in
+ let union pss qss = get_mins Row.le (pss @ qss)
+end
- filter_rec ctx
+exception OrPat
+
+let rec flatten_pat_line size p k =
+ match p.pat_desc with
+ | Tpat_any -> omegas size :: k
+ | Tpat_tuple args -> args :: k
+ | Tpat_or (p1, p2, _) ->
+ flatten_pat_line size p1 (flatten_pat_line size p2 k)
+ | Tpat_alias (p, _, _) ->
+ (* Note: if this 'as' pat is here, then this is a
+ useless binding, solves PR#3780 *)
+ flatten_pat_line size p k
+ | _ -> fatal_error "Matching.flatten_pat_line"
-let select_columns pss ctx =
- let n = ncols pss in
+let flatten_matrix size pss =
List.fold_right
(fun ps r ->
- List.fold_right
- (fun {left=left ; right=right} r ->
- let transfert, right = nchars n right in
- try
- {left = lubs transfert ps @ left ; right=right}::r
- with
- | Empty -> r)
- ctx r)
+ match ps with
+ | [ p ] -> flatten_pat_line size p r
+ | _ -> fatal_error "Matching.flatten_matrix")
pss []
-let ctx_lub p ctx =
- List.fold_right
- (fun {left=left ; right=right} r ->
- match right with
- | q::rem ->
- begin try
- {left=left ; right = lub p q::rem}::r
- with
- | Empty -> r
- end
- | _ -> fatal_error "Matching.ctx_lub")
- ctx []
-
-let ctx_match ctx pss =
- List.exists
- (fun {right=qs} -> List.exists (fun ps -> may_compats qs ps) pss)
- ctx
-
-type jumps = (int * ctx list) list
-
-let pretty_jumps (env : jumps) = match env with
-| [] -> ()
-| _ ->
+(** A default environment (referred to as "reachable trap handlers" in the
+ paper), is an ordered list of [matrix * raise_num] pairs, and is used to
+ decide where to jump next if none of the rows in a given matrix match the
+ input.
+
+ In such situations, one thing you can do is to jump to the first (leftmost)
+ [raise_num] in that list (by doing a raise to the static-cach handler number
+ [raise_num]); and you can assume that if the associated pm doesn't match
+ either, it will do the same thing, etc.
+ This is what [mk_failaction_neg] (and its callers) does.
+
+ A more sophisticated alternative is to use what you know about the input
+ (what you might already have matched) and the current pm (what you know you
+ can't match) to directly jump to a pm that might match it instead of the
+ next one; that is why we don't just keep [raise_num]s but also the
+ associated matrices.
+ [mk_failaction_pos] does (a slightly more sophisticated version of) this.
+*)
+module Default_environment : sig
+ type t
+
+ val is_empty : t -> bool
+
+ val pop : t -> ((matrix * int) * t) option
+
+ val empty : t
+
+ val cons : matrix -> int -> t -> t
+
+ val specialize : (pattern -> pattern list -> pattern list) -> t -> t
+
+ val pop_column : t -> t
+
+ val pop_compat : pattern -> t -> t
+
+ val flatten : int -> t -> t
+
+ val pp : t -> unit
+end = struct
+ type t = (matrix * int) list
+ (** All matrices in the list should have the same arity -- their rows should
+ have the same number of columns -- as it should match the arity of the
+ current scrutiny vector. *)
+
+ let empty = []
+
+ let is_empty = function
+ | [] -> true
+ | _ -> false
+
+ let cons matrix raise_num default =
+ match matrix with
+ | [] -> default
+ | _ -> (matrix, raise_num) :: default
+
+ let specialize_matrix matcher pss =
+ let rec filter_rec = function
+ | (p :: ps) :: rem -> (
+ match p.pat_desc with
+ | Tpat_alias (p, _, _) -> filter_rec ((p :: ps) :: rem)
+ | Tpat_var _ -> filter_rec ((omega :: ps) :: rem)
+ | _ -> (
+ let rem = filter_rec rem in
+ try matcher p ps :: rem with
+ | NoMatch -> rem
+ | OrPat -> (
+ match p.pat_desc with
+ | Tpat_or (p1, p2, _) ->
+ filter_rec [ p1 :: ps; p2 :: ps ] @ rem
+ | _ -> assert false
+ )
+ )
+ )
+ | [] -> []
+ | _ ->
+ pretty_matrix Format.err_formatter pss;
+ fatal_error "Matching.Default_environment.specialize_matrix"
+ in
+ filter_rec pss
+
+ let specialize matcher env =
+ let rec make_rec = function
+ | [] -> []
+ | ([ [] ], i) :: _ -> [ ([ [] ], i) ]
+ | (pss, i) :: rem -> (
+ let rem = make_rec rem in
+ match specialize_matrix matcher pss with
+ | [] -> rem
+ | [] :: _ -> [ ([ [] ], i) ]
+ | pss -> (pss, i) :: rem
+ )
+ in
+ make_rec env
+
+ let pop_column def = specialize (fun _p rem -> rem) def
+
+ let pop_compat p def =
+ let compat_matcher q rem =
+ if may_compat p q then
+ rem
+ else
+ raise NoMatch
+ in
+ specialize compat_matcher def
+
+ let pop = function
+ | [] -> None
+ | def :: defs -> Some (def, defs)
+
+ let pp def =
+ Format.eprintf "+++++ Defaults +++++\n";
List.iter
- (fun (i,ctx) ->
- Printf.fprintf stderr "jump for %d\n" i ;
- pretty_ctx ctx)
+ (fun (pss, i) -> Format.eprintf "Matrix for %d\n%a" i pretty_matrix pss)
+ def;
+ Format.eprintf "+++++++++++++++++++++\n"
+
+ let flatten size def =
+ List.map (fun (pss, i) -> (flatten_matrix size pss, i)) def
+end
+
+module Jumps : sig
+ type t
+
+ val is_empty : t -> bool
+
+ val empty : t
+
+ val singleton : int -> Context.t -> t
+
+ val add : int -> Context.t -> t -> t
+
+ val union : t -> t -> t
+
+ val unions : t list -> t
+
+ val map : (Context.t -> Context.t) -> t -> t
+
+ val remove : int -> t -> t
+
+ val extract : int -> t -> Context.t * t
+
+ val eprintf : t -> unit
+end = struct
+ type t = (int * Context.t) list
+
+ let eprintf (env : t) =
+ List.iter
+ (fun (i, ctx) ->
+ Printf.eprintf "jump for %d\n" i;
+ Context.eprintf ctx)
env
+ let rec extract i = function
+ | [] -> (Context.empty, [])
+ | ((j, pss) as x) :: rem as all ->
+ if i = j then
+ (pss, rem)
+ else if j < i then
+ (Context.empty, all)
+ else
+ let r, rem = extract i rem in
+ (r, x :: rem)
+
+ let rec remove i = function
+ | [] -> []
+ | (j, _) :: rem when i = j -> rem
+ | x :: rem -> x :: remove i rem
-let rec jumps_extract i = function
- | [] -> [],[]
- | (j,pss) as x::rem as all ->
- if i=j then pss,rem
- else if j < i then [],all
- else
- let r,rem = jumps_extract i rem in
- r,(x::rem)
-
-let rec jumps_remove i = function
- | [] -> []
- | (j,_)::rem when i=j -> rem
- | x::rem -> x::jumps_remove i rem
-
-let jumps_empty = []
-and jumps_is_empty = function
- | [] -> true
- | _ -> false
-
-let jumps_singleton i = function
- | [] -> []
- | ctx -> [i,ctx]
-
-let jumps_add i pss jumps = match pss with
-| [] -> jumps
-| _ ->
- let rec add = function
- | [] -> [i,pss]
- | (j,qss) as x::rem as all ->
- if j > i then x::add rem
- else if j < i then (i,pss)::all
- else (i,(get_mins le_ctx (pss@qss)))::rem in
- add jumps
-
-
-let rec jumps_union (env1:(int*ctx list)list) env2 = match env1,env2 with
-| [],_ -> env2
-| _,[] -> env1
-| ((i1,pss1) as x1::rem1), ((i2,pss2) as x2::rem2) ->
- if i1=i2 then
- (i1,get_mins le_ctx (pss1@pss2))::jumps_union rem1 rem2
- else if i1 > i2 then
- x1::jumps_union rem1 env2
+ let empty = []
+
+ and is_empty = function
+ | [] -> true
+ | _ -> false
+
+ let singleton i ctx =
+ if Context.is_empty ctx then
+ []
else
- x2::jumps_union env1 rem2
+ [ (i, ctx) ]
+ let add i ctx jumps =
+ let rec add = function
+ | [] -> [ (i, ctx) ]
+ | ((j, qss) as x) :: rem as all ->
+ if j > i then
+ x :: add rem
+ else if j < i then
+ (i, ctx) :: all
+ else
+ (i, Context.union ctx qss) :: rem
+ in
+ if Context.is_empty ctx then
+ jumps
+ else
+ add jumps
+
+ let rec union (env1 : t) env2 =
+ match (env1, env2) with
+ | [], _ -> env2
+ | _, [] -> env1
+ | ((i1, pss1) as x1) :: rem1, ((i2, pss2) as x2) :: rem2 ->
+ if i1 = i2 then
+ (i1, Context.union pss1 pss2) :: union rem1 rem2
+ else if i1 > i2 then
+ x1 :: union rem1 env2
+ else
+ x2 :: union env1 rem2
-let rec merge = function
- | env1::env2::rem -> jumps_union env1 env2::merge rem
- | envs -> envs
+ let rec merge = function
+ | env1 :: env2 :: rem -> union env1 env2 :: merge rem
+ | envs -> envs
-let rec jumps_unions envs = match envs with
- | [] -> []
- | [env] -> env
- | _ -> jumps_unions (merge envs)
+ let rec unions envs =
+ match envs with
+ | [] -> []
+ | [ env ] -> env
+ | _ -> unions (merge envs)
-let jumps_map f env =
- List.map
- (fun (i,pss) -> i,f pss)
- env
+ let map f env = List.map (fun (i, pss) -> (i, f pss)) env
+end
(* Pattern matching before any compilation *)
-type pattern_matching =
- { mutable cases : (pattern list * lambda) list;
- args : (lambda * let_kind) list ;
- default : (matrix * int) list}
+type pattern_matching = {
+ mutable cases : (pattern list * lambda) list;
+ args : (lambda * let_kind) list;
+ (** args are not just Ident.t in at least the following cases:
+ - when matching the arguments of a constructor,
+ direct field projections are used (make_field_args)
+ - with lazy patterns args can be of the form [Lazy.force ...]
+ (inline_lazy_force). *)
+ default : Default_environment.t
+}
+
+type handler = {
+ provenance : matrix;
+ exit : int;
+ vars : (Ident.t * Lambda.value_kind) list;
+ pm : pattern_matching
+}
+
+type pm_or_compiled = {
+ body : pattern_matching;
+ handlers : handler list;
+ or_matrix : matrix
+}
(* Pattern matching after application of both the or-pat rule and the
mixture rule *)
-type pm_or_compiled =
- {body : pattern_matching ;
- handlers :
- (matrix * int * (Ident.t * Lambda.value_kind) list * pattern_matching)
- list;
- or_matrix : matrix ; }
-
type pm_half_compiled =
| PmOr of pm_or_compiled
- | PmVar of pm_var_compiled
+ | PmVar of { inside : pm_half_compiled }
| Pm of pattern_matching
-and pm_var_compiled =
- {inside : pm_half_compiled ; var_arg : lambda ; }
-
-type pm_half_compiled_info =
- {me : pm_half_compiled ;
- matrix : matrix ;
- top_default : (matrix * int) list ; }
+(* Only used inside the various split functions, we only keep [me] when we're
+ done splitting / precompiling. *)
+type pm_half_compiled_info = {
+ me : pm_half_compiled;
+ matrix : matrix;
+ (* the matrix matched by [me]. Is used to extend the list of reachable trap
+ handlers (aka "default environments") when returning from recursive
+ calls. *)
+ top_default : Default_environment.t
+}
let pretty_cases cases =
List.iter
- (fun (ps,_l) ->
- List.iter
- (fun p -> Format.eprintf " %a%!" top_pretty p)
- ps ;
+ (fun (ps, _l) ->
+ List.iter (fun p -> Format.eprintf " %a%!" top_pretty p) ps;
Format.eprintf "\n")
cases
-let pretty_def def =
- Format.eprintf "+++++ Defaults +++++\n" ;
- List.iter
- (fun (pss,i) -> Format.eprintf "Matrix for %d\n%a" i pretty_matrix pss)
- def ;
- Format.eprintf "+++++++++++++++++++++\n"
-
let pretty_pm pm =
- pretty_cases pm.cases ;
- if pm.default <> [] then
- pretty_def pm.default
-
+ pretty_cases pm.cases;
+ if not (Default_environment.is_empty pm.default) then
+ Default_environment.pp pm.default
let rec pretty_precompiled = function
| Pm pm ->
- Format.eprintf "++++ PM ++++\n" ;
+ Format.eprintf "++++ PM ++++\n";
pretty_pm pm
| PmVar x ->
- Format.eprintf "++++ VAR ++++\n" ;
+ Format.eprintf "++++ VAR ++++\n";
pretty_precompiled x.inside
| PmOr x ->
- Format.eprintf "++++ OR ++++\n" ;
- pretty_pm x.body ;
- pretty_matrix Format.err_formatter x.or_matrix ;
+ Format.eprintf "++++ OR ++++\n";
+ pretty_pm x.body;
+ pretty_matrix Format.err_formatter x.or_matrix;
List.iter
- (fun (_,i,_,pm) ->
- eprintf "++ Handler %d ++\n" i ;
+ (fun { exit = i; pm; _ } ->
+ eprintf "++ Handler %d ++\n" i;
pretty_pm pm)
x.handlers
let pretty_precompiled_res first nexts =
- pretty_precompiled first ;
+ pretty_precompiled first;
List.iter
(fun (e, pmh) ->
- eprintf "** DEFAULT %d **\n" e ;
+ eprintf "** DEFAULT %d **\n" e;
pretty_precompiled pmh)
nexts
-
-
(* Identifying some semantically equivalent lambda-expressions,
Our goal here is also to
find alpha-equivalent (simple) terms *)
in case action sharing is present.
*)
+module StoreExp = Switch.Store (struct
+ type t = lambda
+
+ type key = lambda
-module StoreExp =
- Switch.Store
- (struct
- type t = lambda
- type key = lambda
- let compare_key = Stdlib.compare
- let make_key = Lambda.make_key
- end)
+ let compare_key = Stdlib.compare
+ let make_key = Lambda.make_key
+end)
-let make_exit i = Lstaticraise (i,[])
+let make_exit i = Lstaticraise (i, [])
(* Introduce a catch, if worth it *)
-let make_catch d k = match d with
-| Lstaticraise (_,[]) -> k d
-| _ ->
- let e = next_raise_count () in
- Lstaticcatch (k (make_exit e),(e,[]),d)
+let make_catch d k =
+ match d with
+ | Lstaticraise (_, []) -> k d
+ | _ ->
+ let e = next_raise_count () in
+ Lstaticcatch (k (make_exit e), (e, []), d)
(* Introduce a catch, if worth it, delayed version *)
let rec as_simple_exit = function
- | Lstaticraise (i,[]) -> Some i
- | Llet (Alias,_k,_,_,e) -> as_simple_exit e
+ | Lstaticraise (i, []) -> Some i
+ | Llet (Alias, _k, _, _, e) -> as_simple_exit e
| _ -> None
-
-let make_catch_delayed handler = match as_simple_exit handler with
-| Some i -> i,(fun act -> act)
-| None ->
- let i = next_raise_count () in
-(*
+let make_catch_delayed handler =
+ match as_simple_exit handler with
+ | Some i -> (i, fun act -> act)
+ | None -> (
+ let i = next_raise_count () in
+ (*
Printf.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler);
*)
- i,
- (fun body -> match body with
- | Lstaticraise (j,_) ->
- if i=j then handler else body
- | _ -> Lstaticcatch (body,(i,[]),handler))
-
+ ( i,
+ fun body ->
+ match body with
+ | Lstaticraise (j, _) ->
+ if i = j then
+ handler
+ else
+ body
+ | _ -> Lstaticcatch (body, (i, []), handler) )
+ )
let raw_action l =
- match make_key l with | Some l -> l | None -> l
-
-
-let tr_raw act = match make_key act with
-| Some act -> act
-| None -> raise Exit
+ match make_key l with
+ | Some l -> l
+ | None -> l
let same_actions = function
| [] -> None
- | [_,act] -> Some act
- | (_,act0) :: rem ->
- try
- let raw_act0 = tr_raw act0 in
- let rec s_rec = function
- | [] -> Some act0
- | (_,act)::rem ->
- if raw_act0 = tr_raw act then
- s_rec rem
- else
- None in
- s_rec rem
- with
- | Exit -> None
-
-
-(* Test for swapping two clauses *)
-
-let up_ok_action act1 act2 =
- try
- let raw1 = tr_raw act1
- and raw2 = tr_raw act2 in
- raw1 = raw2
- with
- | Exit -> false
-
-let up_ok (ps,act_p) l =
+ | [ (_, act) ] -> Some act
+ | (_, act0) :: rem -> (
+ match make_key act0 with
+ | None -> None
+ | key0_opt ->
+ let same_act (_, act) = make_key act = key0_opt in
+ if List.for_all same_act rem then
+ Some act0
+ else
+ None
+ )
+
+let safe_before (ps, act_p) l =
+ (* Test for swapping two clauses *)
+ let same_actions act1 act2 =
+ match (make_key act1, make_key act2) with
+ | Some key1, Some key2 -> key1 = key2
+ | None, _
+ | _, None ->
+ false
+ in
List.for_all
- (fun (qs,act_q) ->
- up_ok_action act_p act_q || not (may_compats ps qs))
+ (fun (qs, act_q) -> same_actions act_p act_q || not (may_compats ps qs))
l
(*
- The simplify function normalizes the first column of the match
+ The half-simplify functions transforms the first column of the match
- records are expanded so that they possess all fields
- aliases are removed and replaced by bindings in actions.
- However or-patterns are simplified differently,
- - aliases are not removed
- - or-patterns (_|p) are changed into _
-*)
-exception Var of pattern
-
-let simplify_or p =
- let rec simpl_rec p = match p with
- | {pat_desc = Tpat_any|Tpat_var _} -> raise (Var p)
- | {pat_desc = Tpat_alias (q,id,s)} ->
- begin try
- {p with pat_desc = Tpat_alias (simpl_rec q,id,s)}
- with
- | Var q -> raise (Var {p with pat_desc = Tpat_alias (q,id,s)})
- end
- | {pat_desc = Tpat_or (p1,p2,o)} ->
- let q1 = simpl_rec p1 in
- begin try
- let q2 = simpl_rec p2 in
- {p with pat_desc = Tpat_or (q1, q2, o)}
- with
- | Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)})
- end
- | {pat_desc = Tpat_record (lbls,closed)} ->
+ However or-patterns are only half-simplified,
+ - aliases under or-patterns are kept
+ - or-patterns whose right-hand-side is subsumed by their lhs
+ are simplified to their lhs.
+ For instance: [(_ :: _ | 1 :: _)] is changed into [_ :: _]
+ - or-patterns whose left-hand-side is not simplified
+ are preserved: (p|q) is changed into (simpl(p)|simpl(q))
+ {v
+ # match lazy (print_int 3; 3) with _ | lazy 2 -> ();;
+ - : unit = ()
+ # match lazy (print_int 3; 3) with lazy 2 | _ -> ();;
+ 3- : unit = ()
+ v}
+
+ In particular, or-patterns may still occur in the head of the output row,
+ so this is only a "half-simplification".
+*)
+let half_simplify_cases args cls =
+ let rec simpl_pat p =
+ match p.pat_desc with
+ | Tpat_any
+ | Tpat_var _ ->
+ p
+ | Tpat_alias (q, id, s) ->
+ { p with pat_desc = Tpat_alias (simpl_pat q, id, s) }
+ | Tpat_or (p1, p2, o) ->
+ let p1, p2 = (simpl_pat p1, simpl_pat p2) in
+ if le_pat p1 p2 then
+ p1
+ else
+ { p with pat_desc = Tpat_or (p1, p2, o) }
+ | Tpat_record (lbls, closed) ->
let all_lbls = all_record_args lbls in
- {p with pat_desc=Tpat_record (all_lbls, closed)}
- | _ -> p in
- try
- simpl_rec p
- with
- | Var p -> p
-
-let simplify_cases args cls = match args with
-| [] -> assert false
-| (arg,_)::_ ->
- let rec simplify = function
- | [] -> []
- | ((pat :: patl, action) as cl) :: rem ->
- begin match pat.pat_desc with
- | Tpat_var (id, _) ->
- let k = Typeopt.value_kind pat.pat_env pat.pat_type in
- (omega :: patl, bind_with_value_kind Alias (id, k) arg action) ::
- simplify rem
- | Tpat_any ->
- cl :: simplify rem
- | Tpat_alias(p, id,_) ->
- let k = Typeopt.value_kind pat.pat_env pat.pat_type in
- simplify ((p :: patl,
- bind_with_value_kind Alias (id, k) arg action) :: rem)
- | Tpat_record ([],_) ->
- (omega :: patl, action)::
- simplify rem
- | Tpat_record (lbls, closed) ->
- let all_lbls = all_record_args lbls in
- let full_pat =
- {pat with pat_desc=Tpat_record (all_lbls, closed)} in
- (full_pat::patl,action)::
- simplify rem
- | Tpat_or _ ->
- let pat_simple = simplify_or pat in
- begin match pat_simple.pat_desc with
- | Tpat_or _ ->
- (pat_simple :: patl, action) ::
- simplify rem
- | _ ->
- simplify ((pat_simple::patl,action) :: rem)
- end
- | _ -> cl :: simplify rem
- end
- | _ -> assert false in
-
- simplify cls
-
-
-
-(* Once matchings are simplified one can easily find
- their nature *)
-
-let rec what_is_cases cases = match cases with
-| ({pat_desc=Tpat_any} :: _, _) :: rem -> what_is_cases rem
-| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_,_))}::_),_)::_
- -> assert false (* applies to simplified matchings only *)
-| (p::_,_)::_ -> p
-| [] -> omega
-| _ -> assert false
-
-
-
-(* A few operations on default environments *)
-let as_matrix cases = get_mins le_pats (List.map (fun (ps,_) -> ps) cases)
-
-let cons_default matrix raise_num default =
- match matrix with
- | [] -> default
- | _ -> (matrix,raise_num)::default
-
-let default_compat p def =
- List.fold_right
- (fun (pss,i) r ->
- let qss =
- List.fold_right
- (fun qs r -> match qs with
- | q::rem when may_compat p q -> rem::r
- | _ -> r)
- pss [] in
- match qss with
- | [] -> r
- | _ -> (qss,i)::r)
- def []
+ { p with pat_desc = Tpat_record (all_lbls, closed) }
+ | _ -> p
+ in
+ let rec simpl_clause cl =
+ match cl with
+ | [], _ -> assert false
+ | pat :: patl, action -> (
+ match pat.pat_desc with
+ | Tpat_any -> cl
+ | Tpat_var (id, s) ->
+ let p = { pat with pat_desc = Tpat_alias (omega, id, s) } in
+ simpl_clause (p :: patl, action)
+ | Tpat_alias (p, id, _) ->
+ let arg =
+ match args with
+ | [] -> assert false
+ | (arg, _) :: _ -> arg
+ in
+ let k = Typeopt.value_kind pat.pat_env pat.pat_type in
+ simpl_clause
+ (p :: patl, bind_with_value_kind Alias (id, k) arg action)
+ | Tpat_record ([], _) -> (omega :: patl, action)
+ | Tpat_record (lbls, closed) ->
+ let all_lbls = all_record_args lbls in
+ let full_pat =
+ { pat with pat_desc = Tpat_record (all_lbls, closed) }
+ in
+ (full_pat :: patl, action)
+ | Tpat_or _ -> (
+ let pat_simple = simpl_pat pat in
+ match pat_simple.pat_desc with
+ | Tpat_or _ -> (pat_simple :: patl, action)
+ | _ -> simpl_clause (pat_simple :: patl, action)
+ )
+ | Tpat_constant _
+ | Tpat_tuple _
+ | Tpat_construct _
+ | Tpat_variant _
+ | Tpat_array _
+ | Tpat_lazy _
+ | Tpat_exception _ ->
+ cl
+ )
+ in
+ List.map simpl_clause cls
+
+(* Once matchings are *fully* simplified, one can easily find
+ their nature. *)
+
+let rec what_is_cases ~skip_any cases =
+ match cases with
+ | [] -> omega
+ | ([], _) :: _ -> assert false
+ | (p :: _, _) :: rem -> (
+ match p.pat_desc with
+ | Tpat_any when skip_any -> what_is_cases ~skip_any rem
+ | Tpat_var _
+ | Tpat_or (_, _, _)
+ | Tpat_alias (_, _, _) ->
+ (* applies to simplified matchings only *)
+ assert false
+ | _ -> p
+ )
+
+let what_is_first_case = what_is_cases ~skip_any:false
+
+let what_is_cases = what_is_cases ~skip_any:true
(* Or-pattern expansion, variables are a complication w.r.t. the article *)
let mk_alpha_env arg aliases ids =
List.map
- (fun id -> id,
- if List.mem id aliases then
- match arg with
- | Some v -> v
- | _ -> raise Cannot_flatten
- else
- Ident.create_local (Ident.name id))
+ (fun id ->
+ ( id,
+ if List.mem id aliases then
+ match arg with
+ | Some v -> v
+ | _ -> raise Cannot_flatten
+ else
+ Ident.create_local (Ident.name id) ))
ids
-let rec explode_or_pat arg patl mk_action rem vars aliases = function
- | {pat_desc = Tpat_or (p1,p2,_)} ->
- explode_or_pat
- arg patl mk_action
- (explode_or_pat arg patl mk_action rem vars aliases p2)
- vars aliases p1
- | {pat_desc = Tpat_alias (p,id, _)} ->
- explode_or_pat arg patl mk_action rem vars (id::aliases) p
- | {pat_desc = Tpat_var (x, _)} ->
- let env = mk_alpha_env arg (x::aliases) vars in
- (omega::patl,mk_action (List.map snd env))::rem
- | p ->
+let rec explode_or_pat p arg patl mk_action vars aliases rem =
+ match p.pat_desc with
+ | Tpat_or (p1, p2, _) ->
+ explode_or_pat p1 arg patl mk_action vars aliases
+ (explode_or_pat p2 arg patl mk_action vars aliases rem)
+ | Tpat_alias (p, id, _) ->
+ explode_or_pat p arg patl mk_action vars (id :: aliases) rem
+ | Tpat_var (x, _) ->
+ let env = mk_alpha_env arg (x :: aliases) vars in
+ (omega :: patl, mk_action (List.map snd env)) :: rem
+ | _ ->
let env = mk_alpha_env arg aliases vars in
- (alpha_pat env p::patl,mk_action (List.map snd env))::rem
+ (alpha_pat env p :: patl, mk_action (List.map snd env)) :: rem
-let pm_free_variables {cases=cases} =
+let pm_free_variables { cases } =
List.fold_right
- (fun (_,act) r -> Ident.Set.union (free_variables act) r)
+ (fun (_, act) r -> Ident.Set.union (free_variables act) r)
cases Ident.Set.empty
-
(* Basic grouping predicates *)
let pat_as_constr = function
- | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr
+ | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr
| _ -> fatal_error "Matching.pat_as_constr"
let group_const_int = function
- | {pat_desc= Tpat_constant Const_int _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_int _) } -> true
+ | _ -> false
let group_const_char = function
- | {pat_desc= Tpat_constant Const_char _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_char _) } -> true
+ | _ -> false
let group_const_string = function
- | {pat_desc= Tpat_constant Const_string _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_string _) } -> true
+ | _ -> false
let group_const_float = function
- | {pat_desc= Tpat_constant Const_float _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_float _) } -> true
+ | _ -> false
let group_const_int32 = function
- | {pat_desc= Tpat_constant Const_int32 _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_int32 _) } -> true
+ | _ -> false
let group_const_int64 = function
- | {pat_desc= Tpat_constant Const_int64 _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_int64 _) } -> true
+ | _ -> false
let group_const_nativeint = function
- | {pat_desc= Tpat_constant Const_nativeint _ } -> true
- | _ -> false
+ | { pat_desc = Tpat_constant (Const_nativeint _) } -> true
+ | _ -> false
and group_constructor = function
- | {pat_desc = Tpat_construct (_,_,_)} -> true
+ | { pat_desc = Tpat_construct (_, _, _) } -> true
+ | _ -> false
+
+and group_same_constructor tag = function
+ | { pat_desc = Tpat_construct (_, cstr, _) } ->
+ Types.equal_tag tag cstr.cstr_tag
| _ -> false
and group_variant = function
- | {pat_desc = Tpat_variant (_, _, _)} -> true
+ | { pat_desc = Tpat_variant (_, _, _) } -> true
| _ -> false
and group_var = function
- | {pat_desc=Tpat_any} -> true
+ | { pat_desc = Tpat_any } -> true
| _ -> false
and group_tuple = function
- | {pat_desc = (Tpat_tuple _|Tpat_any)} -> true
+ | { pat_desc = Tpat_tuple _ | Tpat_any } -> true
| _ -> false
and group_record = function
- | {pat_desc = (Tpat_record _|Tpat_any)} -> true
+ | { pat_desc = Tpat_record _ | Tpat_any } -> true
| _ -> false
and group_array = function
- | {pat_desc=Tpat_array _} -> true
+ | { pat_desc = Tpat_array _ } -> true
| _ -> false
and group_lazy = function
- | {pat_desc = Tpat_lazy _} -> true
+ | { pat_desc = Tpat_lazy _ } -> true
| _ -> false
-let get_group p = match p.pat_desc with
-| Tpat_any -> group_var
-| Tpat_constant Const_int _ -> group_const_int
-| Tpat_constant Const_char _ -> group_const_char
-| Tpat_constant Const_string _ -> group_const_string
-| Tpat_constant Const_float _ -> group_const_float
-| Tpat_constant Const_int32 _ -> group_const_int32
-| Tpat_constant Const_int64 _ -> group_const_int64
-| Tpat_constant Const_nativeint _ -> group_const_nativeint
-| Tpat_construct _ -> group_constructor
-| Tpat_tuple _ -> group_tuple
-| Tpat_record _ -> group_record
-| Tpat_array _ -> group_array
-| Tpat_variant (_,_,_) -> group_variant
-| Tpat_lazy _ -> group_lazy
-| _ -> fatal_error "Matching.get_group"
-
-
-
-let is_or p = match p.pat_desc with
-| Tpat_or _ -> true
-| _ -> false
-
-(* Conditions for appending to the Or matrix *)
-let conda p q = not (may_compat p q)
-and condb act ps qs = not (is_guarded act) && Parmatch.le_pats qs ps
-
-let or_ok p ps l =
- List.for_all
- (function
- | ({pat_desc=Tpat_or _} as q::qs,act) ->
- conda p q || condb act ps qs
- | _ -> true)
- l
+let can_group p =
+ match p.pat_desc with
+ | Tpat_any -> group_var
+ | Tpat_constant (Const_int _) -> group_const_int
+ | Tpat_constant (Const_char _) -> group_const_char
+ | Tpat_constant (Const_string _) -> group_const_string
+ | Tpat_constant (Const_float _) -> group_const_float
+ | Tpat_constant (Const_int32 _) -> group_const_int32
+ | Tpat_constant (Const_int64 _) -> group_const_int64
+ | Tpat_constant (Const_nativeint _) -> group_const_nativeint
+ | Tpat_construct (_, { cstr_tag = Cstr_extension _ as t }, _) ->
+ (* Extension constructors with distinct names may be equal thanks to
+ constructor rebinding. So we need to produce a specialized
+ submatrix for each syntactically-distinct constructor (with a threading
+ of exits such that each submatrix falls back to the
+ potentially-compatible submatrices below it). *)
+ group_same_constructor t
+ | Tpat_construct _ -> group_constructor
+ | Tpat_tuple _ -> group_tuple
+ | Tpat_record _ -> group_record
+ | Tpat_array _ -> group_array
+ | Tpat_variant (_, _, _) -> group_variant
+ | Tpat_lazy _ -> group_lazy
+ | _ -> fatal_error "Matching.can_group"
+
+let is_or p =
+ match p.pat_desc with
+ | Tpat_or _ -> true
+ | _ -> false
-(* Insert or append a pattern in the Or matrix *)
+let rec omega_like p =
+ match p.pat_desc with
+ | Tpat_any
+ | Tpat_var _ ->
+ true
+ | Tpat_alias (p, _, _) -> omega_like p
+ | Tpat_or (p1, p2, _) -> omega_like p1 || omega_like p2
+ | _ -> false
let equiv_pat p q = le_pat p q && le_pat q p
-let rec get_equiv p l = match l with
- | (q::_,_) as cl::rem ->
+let rec extract_equiv_head p l =
+ match l with
+ | ((q :: _, _) as cl) :: rem ->
if equiv_pat p q then
- let others,rem = get_equiv p rem in
- cl::others,rem
+ let others, rem = extract_equiv_head p rem in
+ (cl :: others, rem)
else
- [],l
- | _ -> [],l
-
-
-let insert_or_append p ps act ors no =
- let rec attempt seen = function
- | (q::qs,act_q) as cl::rem ->
- if is_or q then begin
- if may_compat p q then
- if
- Typedtree.pat_bound_idents p = [] &&
- Typedtree.pat_bound_idents q = [] &&
- equiv_pat p q
- then (* attempt insert, for equivalent orpats with no variables *)
- let _, not_e = get_equiv q rem in
- if
- or_ok p ps not_e && (* check append condition for head of O *)
- List.for_all (* check insert condition for tail of O *)
- (fun cl -> match cl with
- | (q::_,_) -> not (may_compat p q)
- | _ -> assert false)
- seen
- then (* insert *)
- List.rev_append seen ((p::ps,act)::cl::rem), no
- else (* fail to insert or append *)
- ors,(p::ps,act)::no
- else if condb act_q ps qs then (* check condition (b) for append *)
- attempt (cl::seen) rem
+ ([], l)
+ | _ -> ([], l)
+
+module Or_matrix = struct
+ (* Splitting a matrix uses an or-matrix that contains or-patterns (at
+ the head of some of its rows).
+
+ The property that we want to maintain for the rows of the
+ or-matrix is that if the row p::ps is before q::qs and p is an
+ or-pattern, and v::vs matches p but not ps, then we don't need to
+ try q::qs. This is necessary because the compilation of the
+ or-pattern p will exit to a sub-matrix and never come back.
+
+ For this to hold, (p::ps) and (q::qs) must satisfy one of:
+ - disjointness: p and q are not compatible
+ - ordering: if p and q are compatible, ps is more general than qs
+ (this only works if the row p::ps is not guarded; otherwise the
+ guard could fail and q::qs should still be tried)
+ *)
+
+ (* Conditions for appending to the Or matrix *)
+ let disjoint p q = not (may_compat p q)
+
+ let safe_below (ps, act) qs =
+ (not (is_guarded act)) && Parmatch.le_pats ps qs
+
+ let safe_below_or_matrix l (q, qs) =
+ List.for_all
+ (function
+ | ({ pat_desc = Tpat_or _ } as p) :: ps, act_p ->
+ disjoint p q || safe_below (ps, act_p) qs
+ | _ -> true)
+ l
+
+ (* Insert or append a clause in the Or matrix:
+ - insert: adding the clause in the middle of the or_matrix
+ - append: adding the clause at the bottom of the or_matrix
+
+ If neither are possible we add to the bottom of the No matrix.
+ *)
+ let insert_or_append (p, ps, act) rev_ors rev_no =
+ let safe_to_insert rem (p, ps) seen =
+ let _, not_e = extract_equiv_head p rem in
+ (* check append condition for head of O *)
+ safe_below_or_matrix not_e (p, ps)
+ && (* check insert condition for tail of O *)
+ List.for_all
+ (fun cl ->
+ match cl with
+ | q :: _, _ -> disjoint p q
+ | _ -> assert false)
+ seen
+ in
+ let rec attempt seen = function
+ (* invariant: the new clause is safe to append at the end of
+ [seen] (but maybe not [rem] yet) *)
+ | [] -> ((p :: ps, act) :: rev_ors, rev_no)
+ | ([], _act) :: _ -> assert false
+ | ((q :: qs, act_q) as cl) :: rem ->
+ if (not (is_or q)) || disjoint p q then
+ attempt (cl :: seen) rem
+ else if
+ Typedtree.pat_bound_idents p = []
+ && Typedtree.pat_bound_idents q = []
+ && equiv_pat p q
+ then
+ (* attempt insertion, for equivalent orpats with no variables *)
+ if safe_to_insert rem (p, ps) seen then
+ (List.rev_append seen ((p :: ps, act) :: cl :: rem), rev_no)
else
- ors,(p::ps,act)::no
- else (* p # q, go on with append/insert *)
- attempt (cl::seen) rem
- end else (* q is not an or-pat, go on with append/insert *)
- attempt (cl::seen) rem
- | _ -> (* [] in fact *)
- (p::ps,act)::ors,no in (* success in appending *)
- attempt [] ors
+ (* fail to insert or append *)
+ (rev_ors, (p :: ps, act) :: rev_no)
+ else if safe_below (qs, act_q) ps then
+ attempt (cl :: seen) rem
+ else
+ (rev_ors, (p :: ps, act) :: rev_no)
+ in
+ attempt [] rev_ors
+end
(* Reconstruct default information from half_compiled pm list *)
-let rec rebuild_matrix pmh = match pmh with
- | Pm pm -> as_matrix pm.cases
- | PmOr {or_matrix=m} -> m
- | PmVar x -> add_omega_column (rebuild_matrix x.inside)
-
-let rec rebuild_default nexts def = match nexts with
-| [] -> def
-| (e, pmh)::rem ->
- (add_omega_column (rebuild_matrix pmh), e)::
- rebuild_default rem def
-
-let rebuild_nexts arg nexts k =
- List.fold_right
- (fun (e, pm) k -> (e, PmVar {inside=pm ; var_arg=arg})::k)
- nexts k
-
+let as_matrix cases = get_mins le_pats (List.map (fun (ps, _) -> ps) cases)
(*
- Split a matching.
+ Split a matching along the first column.
+
Splitting is first directed by or-patterns, then by
tests (e.g. constructors)/variable transitions.
Some precompilation of or-patterns and
variable pattern occurs. Mostly this means that bindings
are performed now, being replaced by let-bindings
- in actions (cf. simplify_cases).
+ in actions (cf. half_simplify_cases).
Additionally, if the match argument is a variable, matchings whose
first column is made of variables only are split further
(cf. precompile_var).
-*)
+ ---
+
+ Note: we assume that the first column of each pattern is coherent -- all
+ patterns match values of the same type. This comes from the fact that
+ we make agressive splitting decisions, splitting pattern heads that
+ may be different into different submatrices; in particular, in a given
+ submatrix the first column is formed of first arguments to the same
+ constructor.
+
+ GADTs are not an issue because we split columns left-to-right, and
+ GADT typing also introduces typing equations left-to-right. In
+ particular, a leftmost column in matching.ml will be well-typed under
+ a set of equations accepted by the type-checker, and those equations
+ are forced to remain consistent: they can equate known types to
+ abstract types, but they cannot equate two incompatible known types
+ together, and in particular incompatible pattern heads do not appear
+ in a leftmost column.
+
+ Parmatch has to be more conservative because it splits less
+ agressively: submatrices will contain not just the arguments of
+ a given pattern head, but also other lines that may be compatible with
+ it, in particular those with a leftmost omega and those starting with
+ an extension constructor that may be equal to it.
+*)
let rec split_or argo cls args def =
-
- let cls = simplify_cases args cls in
-
- let rec do_split before ors no = function
+ let cls = half_simplify_cases args cls in
+ let rec do_split rev_before rev_ors rev_no = function
| [] ->
- cons_next
- (List.rev before) (List.rev ors) (List.rev no)
- | ((p::ps,act) as cl)::rem ->
- if up_ok cl no then
- if is_or p then
- let ors, no = insert_or_append p ps act ors no in
- do_split before ors no rem
- else begin
- if up_ok cl ors then
- do_split (cl::before) ors no rem
- else if or_ok p ps ors then
- do_split before (cl::ors) no rem
- else
- do_split before ors (cl::no) rem
- end
+ cons_next (List.rev rev_before) (List.rev rev_ors) (List.rev rev_no)
+ | ((p :: ps, act) as cl) :: rem ->
+ if not (safe_before cl rev_no) then
+ do_split rev_before rev_ors (cl :: rev_no) rem
+ else if (not (is_or p)) && safe_before cl rev_ors then
+ do_split (cl :: rev_before) rev_ors rev_no rem
else
- do_split before ors (cl::no) rem
+ let rev_ors, rev_no =
+ Or_matrix.insert_or_append (p, ps, act) rev_ors rev_no
+ in
+ do_split rev_before rev_ors rev_no rem
| _ -> assert false
-
- and cons_next yes yesor = function
- | [] ->
- precompile_or argo yes yesor args def []
- | rem ->
- let {me=next ; matrix=matrix ; top_default=def},nexts =
- do_split [] [] [] rem in
- let idef = next_raise_count () in
- precompile_or
- argo yes yesor args
- (cons_default matrix idef def)
- ((idef,next)::nexts) in
-
+ and cons_next yes yesor no =
+ let def, nexts =
+ match no with
+ | [] -> (def, [])
+ | _ ->
+ let { me = next; matrix; top_default = def }, nexts =
+ do_split [] [] [] no
+ in
+ let idef = next_raise_count () in
+ (Default_environment.cons matrix idef def, (idef, next) :: nexts)
+ in
+ match yesor with
+ | [] -> split_no_or yes args def nexts
+ | _ -> precompile_or argo yes yesor args def nexts
+ in
do_split [] [] [] cls
-(* Ultra-naive splitting, close to semantics, used for extension,
- as potential rebind prevents any kind of optimisation *)
-
-and split_naive cls args def k =
-
- let rec split_exc cstr0 yes = function
+and split_no_or cls args def k =
+ (* We split the remaining clauses in as few pms as possible while maintaining
+ the property stated earlier (cf. {1. Precompilation}), i.e. for
+ any pm in the result, it is possible to decide for any two patterns
+ on the first column whether their heads are equal or not.
+
+ This generally means that we'll have two kinds of pms: ones where the first
+ column is made of variables only, and ones where the head is actually a
+ discriminating pattern.
+
+ There is some subtlety regarding the handling of extension constructors
+ (where it is not always possible to syntactically decide whether two
+ different heads match different values), but this is handled by the
+ [can_group] function. *)
+ let rec split cls =
+ let discr = what_is_first_case cls in
+ collect discr [] [] cls
+ and collect group_discr rev_yes rev_no = function
+ | ([], _) :: _ -> assert false
+ | [ ((ps, _) as cl) ] when rev_yes <> [] && List.for_all omega_like ps ->
+ (* This enables an extra division in some frequent cases:
+ last row is made of variables only
+
+ Splitting a matrix there creates two default environments (instead of
+ one for the non-split matrix), the first of which often gets
+ specialized away by further refinement, and the second one jumping
+ directly to the catch-all case -- this produces better code.
+
+ This optimisation is tested in the first part of
+ testsuite/tests/basic/patmatch_split_no_or.ml *)
+ collect group_discr rev_yes (cl :: rev_no) []
+ | ((p :: _, _) as cl) :: rem ->
+ if can_group group_discr p && safe_before cl rev_no then
+ collect group_discr (cl :: rev_yes) rev_no rem
+ else if should_split group_discr then (
+ assert (rev_no = []);
+ let yes = List.rev rev_yes in
+ insert_split group_discr yes (cl :: rem) def k
+ ) else
+ collect group_discr rev_yes (cl :: rev_no) rem
| [] ->
- let yes = List.rev yes in
- { me = Pm {cases=yes; args=args; default=def;} ;
- matrix = as_matrix yes ;
- top_default=def},
- k
- | (p::_,_ as cl)::rem ->
- if group_constructor p then
- let cstr = pat_as_constr p in
- if cstr = cstr0 then split_exc cstr0 (cl::yes) rem
- else
- let yes = List.rev yes in
- let {me=next ; matrix=matrix ; top_default=def}, nexts =
- split_exc cstr [cl] rem in
- let idef = next_raise_count () in
- let def = cons_default matrix idef def in
- { me = Pm {cases=yes; args=args; default=def} ;
- matrix = as_matrix yes ;
- top_default = def; },
- (idef,next)::nexts
- else
- let yes = List.rev yes in
- let {me=next ; matrix=matrix ; top_default=def}, nexts =
- split_noexc [cl] rem in
- let idef = next_raise_count () in
- let def = cons_default matrix idef def in
- { me = Pm {cases=yes; args=args; default=def} ;
- matrix = as_matrix yes ;
- top_default = def; },
- (idef,next)::nexts
- | _ -> assert false
-
- and split_noexc yes = function
- | [] -> precompile_var args (List.rev yes) def k
- | (p::_,_ as cl)::rem ->
- if group_constructor p then
- let yes= List.rev yes in
- let {me=next; matrix=matrix; top_default=def;},nexts =
- split_exc (pat_as_constr p) [cl] rem in
- let idef = next_raise_count () in
- precompile_var
- args yes
- (cons_default matrix idef def)
- ((idef,next)::nexts)
- else split_noexc (cl::yes) rem
- | _ -> assert false in
-
- match cls with
- | [] -> assert false
- | (p::_,_ as cl)::rem ->
- if group_constructor p then
- split_exc (pat_as_constr p) [cl] rem
+ let yes = List.rev rev_yes and no = List.rev rev_no in
+ insert_split group_discr yes no def k
+ and insert_split group_discr yes no def k =
+ let precompile_group =
+ if group_var group_discr then
+ precompile_var
else
- split_noexc [cl] rem
- | _ -> assert false
-
-and split_constr cls args def k =
- let ex_pat = what_is_cases cls in
- match ex_pat.pat_desc with
- | Tpat_any -> precompile_var args cls def k
- | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) ->
- split_naive cls args def k
- | _ ->
-
- let group = get_group ex_pat in
-
- let rec split_ex yes no = function
- | [] ->
- let yes = List.rev yes and no = List.rev no in
- begin match no with
- | [] ->
- {me = Pm {cases=yes ; args=args ; default=def} ;
- matrix = as_matrix yes ;
- top_default = def},
- k
- | cl::rem ->
- begin match yes with
- | [] ->
- (* Could not success in raising up a constr matching up *)
- split_noex [cl] [] rem
- | _ ->
- let {me=next ; matrix=matrix ; top_default=def}, nexts =
- split_noex [cl] [] rem in
- let idef = next_raise_count () in
- let def = cons_default matrix idef def in
- {me = Pm {cases=yes ; args=args ; default=def} ;
- matrix = as_matrix yes ;
- top_default = def },
- (idef, next)::nexts
- end
- end
- | (p::_,_) as cl::rem ->
- if group p && up_ok cl no then
- split_ex (cl::yes) no rem
- else
- split_ex yes (cl::no) rem
- | _ -> assert false
+ do_not_precompile
+ in
+ match no with
+ | [] -> precompile_group args yes def k
+ | _ ->
+ let { me = next; matrix; top_default = def }, nexts = split no in
+ let idef = next_raise_count () in
+ precompile_group args yes
+ (Default_environment.cons matrix idef def)
+ ((idef, next) :: nexts)
+ and should_split group_discr =
+ match group_discr.pat_desc with
+ | Tpat_construct (_, { cstr_tag = Cstr_extension _ }, _) ->
+ (* it is unlikely that we will raise anything, so we split now *)
+ true
+ | _ -> false
+ in
+ split cls
- and split_noex yes no = function
- | [] ->
- let yes = List.rev yes and no = List.rev no in
- begin match no with
- | [] -> precompile_var args yes def k
- | cl::rem ->
- let {me=next ; matrix=matrix ; top_default=def}, nexts =
- split_ex [cl] [] rem in
- let idef = next_raise_count () in
- precompile_var
- args yes
- (cons_default matrix idef def)
- ((idef,next)::nexts)
- end
- | [ps,_ as cl]
- when List.for_all group_var ps && yes <> [] ->
- (* This enables an extra division in some frequent cases :
- last row is made of variables only *)
- split_noex yes (cl::no) []
- | (p::_,_) as cl::rem ->
- if not (group p) && up_ok cl no then
- split_noex (cl::yes) no rem
- else
- split_noex yes (cl::no) rem
- | _ -> assert false in
+and precompile_var args cls def k =
+ (* Strategy: pop the first column,
+ precompile the rest, add a PmVar to all precompiled submatrices.
+ If the rest doesn't generate any split, abort and do_not_precompile. *)
+ match args with
+ | [] -> assert false
+ | _ :: ((Lvar v, _) as arg) :: rargs -> (
+ (* We will use the name of the head column of the submatrix
+ we compile, and this is the *second* column of our argument. *)
match cls with
- | ((p::_,_) as cl)::rem ->
- if group p then split_ex [cl] [] rem
- else split_noex [cl] [] rem
- | _ -> assert false
-
-and precompile_var args cls def k = match args with
-| [] -> assert false
-| _::((Lvar v as av,_) as arg)::rargs ->
- begin match cls with
- | [_] -> (* as split as it can *)
- dont_precompile_var args cls def k
- | _ ->
-(* Precompile *)
- let var_cls =
- List.map
- (fun (ps,act) -> match ps with
- | _::ps -> ps,act | _ -> assert false)
- cls
- and var_def = make_default (fun _ rem -> rem) def in
- let {me=first ; matrix=matrix}, nexts =
- split_or (Some v) var_cls (arg::rargs) var_def in
-
-(* Compute top information *)
- match nexts with
- | [] -> (* If you need *)
- dont_precompile_var args cls def k
- | _ ->
- let rfirst =
- {me = PmVar {inside=first ; var_arg = av} ;
- matrix = add_omega_column matrix ;
- top_default = rebuild_default nexts def ; }
- and rnexts = rebuild_nexts av nexts k in
- rfirst, rnexts
- end
-| _ ->
- dont_precompile_var args cls def k
-
-and dont_precompile_var args cls def k =
- {me = Pm {cases = cls ; args = args ; default = def } ;
- matrix=as_matrix cls ;
- top_default=def},k
-
-and precompile_or argo cls ors args def k = match ors with
-| [] -> split_constr cls args def k
-| _ ->
- let rec do_cases = function
- | ({pat_desc=Tpat_or _} as orp::patl, action)::rem ->
- let others,rem = get_equiv orp rem in
- let orpm =
- {cases =
- (patl, action)::
- List.map
- (function
- | (_::ps,action) -> ps,action
- | _ -> assert false)
- others ;
- args = (match args with _::r -> r | _ -> assert false) ;
- default = default_compat orp def} in
- let pm_fv = pm_free_variables orpm in
- let vars =
- Typedtree.pat_bound_idents_full orp
- |> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv)
- |> List.map (fun (id,_,ty) -> id,Typeopt.value_kind orp.pat_env ty)
+ | [ _ ] ->
+ (* as split as it can *)
+ do_not_precompile args cls def k
+ | _ -> (
+ (* Precompile *)
+ let var_cls =
+ List.map
+ (fun (ps, act) ->
+ match ps with
+ | p :: ps ->
+ assert (group_var p);
+ (ps, act)
+ | _ -> assert false)
+ cls
+ and var_def = Default_environment.pop_column def in
+ let { me = first; matrix }, nexts =
+ split_or (Some v) var_cls (arg :: rargs) var_def
in
- let or_num = next_raise_count () in
- let new_patl = Parmatch.omega_list patl in
-
- let mk_new_action vs =
- Lstaticraise
- (or_num, List.map (fun v -> Lvar v) vs) in
-
- let body,handlers = do_cases rem in
- explode_or_pat
- argo new_patl mk_new_action body (List.map fst vars) [] orp,
- let mat = [[orp]] in
- ((mat, or_num, vars , orpm):: handlers)
- | cl::rem ->
- let new_ord,new_to_catch = do_cases rem in
- cl::new_ord,new_to_catch
- | [] -> [],[] in
-
- let end_body, handlers = do_cases ors in
- let matrix = as_matrix (cls@ors)
- and body = {cases=cls@end_body ; args=args ; default=def} in
- {me = PmOr {body=body ; handlers=handlers ; or_matrix=matrix} ;
- matrix=matrix ;
- top_default=def},
- k
-
-let split_precompile argo pm =
- let {me=next}, nexts = split_or argo pm.cases pm.args pm.default in
- if dbg && (nexts <> [] || (match next with PmOr _ -> true | _ -> false))
- then begin
- Format.eprintf "** SPLIT **\n" ;
- pretty_pm pm ;
- pretty_precompiled_res next nexts
- end ;
- next, nexts
-
+ (* Compute top information *)
+ match nexts with
+ | [] ->
+ (* If you need *)
+ do_not_precompile args cls def k
+ | _ ->
+ let rec rebuild_matrix pmh =
+ match pmh with
+ | Pm pm -> as_matrix pm.cases
+ | PmOr { or_matrix = m } -> m
+ | PmVar x -> add_omega_column (rebuild_matrix x.inside)
+ in
+ let rebuild_default nexts def =
+ (* We can't just do:
+ {[
+ List.map
+ (fun (mat, e) -> add_omega_column mat, e)
+ top_default (* assuming it'd been bound. *)
+ ]}
+ As we would be loosing information: [def] is more precise
+ than [add_omega_column (pop_column def)]. *)
+ List.fold_right
+ (fun (e, pmh) ->
+ Default_environment.cons
+ (add_omega_column (rebuild_matrix pmh))
+ e)
+ nexts def
+ in
+ let rebuild_nexts nexts k =
+ map_end (fun (e, pm) -> (e, PmVar { inside = pm })) nexts k
+ in
+ let rfirst =
+ { me = PmVar { inside = first };
+ matrix = add_omega_column matrix;
+ top_default = rebuild_default nexts def
+ }
+ and rnexts = rebuild_nexts nexts k in
+ (rfirst, rnexts)
+ )
+ )
+ | _ -> do_not_precompile args cls def k
+
+and do_not_precompile args cls def k =
+ ( { me = Pm { cases = cls; args; default = def };
+ matrix = as_matrix cls;
+ top_default = def
+ },
+ k )
+
+and precompile_or argo cls ors args def k =
+ let rec do_cases = function
+ | (({ pat_desc = Tpat_or _ } as orp) :: patl, action) :: rem ->
+ let others, rem = extract_equiv_head orp rem in
+ let orpm =
+ { cases =
+ (patl, action)
+ :: List.map
+ (function
+ | _ :: ps, action -> (ps, action)
+ | _ -> assert false)
+ others;
+ args =
+ ( match args with
+ | _ :: r -> r
+ | _ -> assert false
+ );
+ default = Default_environment.pop_compat orp def
+ }
+ in
+ let pm_fv = pm_free_variables orpm in
+ let vars =
+ (* bound variables of the or-pattern and used in the orpm actions *)
+ Typedtree.pat_bound_idents_full orp
+ |> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv)
+ |> List.map (fun (id, _, ty) ->
+ (id, Typeopt.value_kind orp.pat_env ty))
+ in
+ let or_num = next_raise_count () in
+ let new_patl = Parmatch.omega_list patl in
+ let mk_new_action vs =
+ Lstaticraise (or_num, List.map (fun v -> Lvar v) vs)
+ in
+ let rem_cases, rem_handlers = do_cases rem in
+ let cases =
+ explode_or_pat orp argo new_patl mk_new_action (List.map fst vars) []
+ rem_cases
+ in
+ let handler =
+ { provenance = [ [ orp ] ]; exit = or_num; vars; pm = orpm }
+ in
+ (cases, handler :: rem_handlers)
+ | cl :: rem ->
+ let new_ord, new_to_catch = do_cases rem in
+ (cl :: new_ord, new_to_catch)
+ | [] -> ([], [])
+ in
+ let cases, handlers = do_cases ors in
+ let matrix = as_matrix (cls @ ors)
+ and body = { cases = cls @ cases; args; default = def } in
+ ( { me = PmOr { body; handlers; or_matrix = matrix };
+ matrix;
+ top_default = def
+ },
+ k )
+
+let split_and_precompile argo pm =
+ let { me = next }, nexts = split_or argo pm.cases pm.args pm.default in
+ if
+ dbg
+ && (nexts <> []
+ ||
+ match next with
+ | PmOr _ -> true
+ | _ -> false
+ )
+ then (
+ Format.eprintf "** SPLIT **\n";
+ pretty_pm pm;
+ pretty_precompiled_res next nexts
+ );
+ (next, nexts)
(* General divide functions *)
-let add_line patl_action pm = pm.cases <- patl_action :: pm.cases; pm
-
-type cell =
- {pm : pattern_matching ;
- ctx : ctx list ;
- pat : pattern}
-
-let add make_matching_fun division eq_key key patl_action args =
- try
- let (_,cell) = List.find (fun (k,_) -> eq_key key k) division in
- cell.pm.cases <- patl_action :: cell.pm.cases;
- division
- with Not_found ->
- let cell = make_matching_fun args in
- cell.pm.cases <- [patl_action] ;
- (key, cell) :: division
-
-
-let divide make eq_key get_key get_args ctx pm =
-
- let rec divide_rec = function
- | (p::patl,action) :: rem ->
- let this_match = divide_rec rem in
- add
- (make p pm.default ctx)
- this_match eq_key (get_key p) (get_args p patl,action) pm.args
- | _ -> [] in
-
- divide_rec pm.cases
-
-
-let divide_line make_ctx make get_args pat ctx pm =
- let rec divide_rec = function
- | (p::patl,action) :: rem ->
- let this_match = divide_rec rem in
- add_line (get_args p patl, action) this_match
- | _ -> make pm.default pm.args in
-
- {pm = divide_rec pm.cases ;
- ctx=make_ctx ctx ;
- pat=pat}
+type cell = { pm : pattern_matching; ctx : Context.t; discr : pattern }
+(** a submatrix after specializing by discriminant pattern;
+ [ctx] is the context shared by all rows. *)
+
+type 'a division = {
+ args : (lambda * let_kind) list;
+ cells : ('a * cell) list
+}
+
+let add_in_div make_matching_fun eq_key key patl_action division =
+ let cells =
+ match List.find_opt (fun (k, _) -> eq_key key k) division.cells with
+ | None ->
+ let cell = make_matching_fun division.args in
+ cell.pm.cases <- [ patl_action ];
+ (key, cell) :: division.cells
+ | Some (_, cell) ->
+ cell.pm.cases <- patl_action :: cell.pm.cases;
+ division.cells
+ in
+ { division with cells }
+
+let divide make eq_key get_key get_args ctx (pm : pattern_matching) =
+ let add clause division =
+ match clause with
+ | [], _ -> assert false
+ | p :: patl, action ->
+ add_in_div (make p pm.default ctx) eq_key (get_key p)
+ (get_args p patl, action)
+ division
+ in
+ List.fold_right add pm.cases { args = pm.args; cells = [] }
+let add_line patl_action pm =
+ pm.cases <- patl_action :: pm.cases;
+ pm
+let divide_line make_ctx make get_args discr ctx (pm : pattern_matching) =
+ let add clause submatrix =
+ match clause with
+ | [], _ -> assert false
+ | p :: patl, action -> add_line (get_args p patl, action) submatrix
+ in
+ let pm = List.fold_right add pm.cases (make pm.default pm.args) in
+ { pm; ctx = make_ctx ctx; discr }
(* Then come various functions,
There is one set of functions per matching style
(constants, constructors etc.)
- - matcher functions are arguments to make_default (for default handlers)
+ - matcher functions are arguments to Default_environment.specialize (for
+ default handlers)
They may raise NoMatch or OrPat and perform the full
matching (selection + arguments).
-
- get_args and get_key are for the compiled matrices, note that
selection and getting arguments are separated.
- - make_ _matching combines the previous functions for producing
+ - make_*_matching combines the previous functions for producing
new ``pattern_matching'' records.
*)
-
-
-let rec matcher_const cst p rem = match p.pat_desc with
-| Tpat_or (p1,p2,_) ->
- begin try
- matcher_const cst p1 rem with
- | NoMatch -> matcher_const cst p2 rem
- end
-| Tpat_constant c1 when const_compare c1 cst = 0 -> rem
-| Tpat_any -> rem
-| _ -> raise NoMatch
+let rec matcher_const cst p rem =
+ match p.pat_desc with
+ | Tpat_or (p1, p2, _) -> (
+ try matcher_const cst p1 rem with NoMatch -> matcher_const cst p2 rem
+ )
+ | Tpat_constant c1 when const_compare c1 cst = 0 -> rem
+ | Tpat_any -> rem
+ | _ -> raise NoMatch
let get_key_constant caller = function
- | {pat_desc= Tpat_constant cst} -> cst
+ | { pat_desc = Tpat_constant cst } -> cst
| p ->
- Format.eprintf "BAD: %s" caller ;
- pretty_pat p ;
+ Format.eprintf "BAD: %s" caller;
+ pretty_pat p;
assert false
let get_args_constant _ rem = rem
let make_constant_matching p def ctx = function
- [] -> fatal_error "Matching.make_constant_matching"
- | (_ :: argl) ->
+ | [] -> fatal_error "Matching.make_constant_matching"
+ | _ :: argl ->
let def =
- make_default
- (matcher_const (get_key_constant "make" p)) def
- and ctx =
- filter_ctx p ctx in
- {pm = {cases = []; args = argl ; default = def} ;
- ctx = ctx ;
- pat = normalize_pat p}
-
-
-
+ Default_environment.specialize
+ (matcher_const (get_key_constant "make" p))
+ def
+ and ctx = Context.specialize p ctx in
+ { pm = { cases = []; args = argl; default = def };
+ ctx;
+ discr = normalize_pat p
+ }
let divide_constant ctx m =
- divide
- make_constant_matching
- (fun c d -> const_compare c d = 0) (get_key_constant "divide")
- get_args_constant
- ctx m
+ divide make_constant_matching
+ (fun c d -> const_compare c d = 0)
+ (get_key_constant "divide")
+ get_args_constant ctx m
(* Matching against a constructor *)
-
let make_field_args loc binding_kind arg first_pos last_pos argl =
let rec make_args pos =
- if pos > last_pos
- then argl
- else (Lprim(Pfield pos, [arg], loc), binding_kind) :: make_args (pos + 1)
- in make_args first_pos
+ if pos > last_pos then
+ argl
+ else
+ (Lprim (Pfield pos, [ arg ], loc), binding_kind) :: make_args (pos + 1)
+ in
+ make_args first_pos
let get_key_constr = function
- | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr.cstr_tag
+ | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr.cstr_tag
| _ -> assert false
-let get_args_constr p rem = match p with
-| {pat_desc=Tpat_construct (_, _, args)} -> args @ rem
-| _ -> assert false
+let get_args_constr p rem =
+ match p with
+ | { pat_desc = Tpat_construct (_, _, args) } -> args @ rem
+ | _ -> assert false
(* NB: matcher_constr applies to default matrices.
This comparison is performed by Types.may_equal_constr.
*)
-let matcher_constr cstr = match cstr.cstr_arity with
-| 0 ->
- let rec matcher_rec q rem = match q.pat_desc with
- | Tpat_or (p1,p2,_) ->
- begin
- try matcher_rec p1 rem
- with NoMatch -> matcher_rec p2 rem
- end
- | Tpat_construct (_, cstr',[])
- when Types.may_equal_constr cstr cstr' -> rem
- | Tpat_any -> rem
- | _ -> raise NoMatch in
- matcher_rec
-| 1 ->
- let rec matcher_rec q rem = match q.pat_desc with
- | Tpat_or (p1,p2,_) ->
- let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
- and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
- begin match r1,r2 with
- | None, None -> raise NoMatch
- | Some r1, None -> r1
- | None, Some r2 -> r2
- | Some (a1::_), Some (a2::_) ->
- {a1 with
- pat_loc = Location.none ;
- pat_desc = Tpat_or (a1, a2, None)}::
+let matcher_constr cstr =
+ match cstr.cstr_arity with
+ | 0 ->
+ let rec matcher_rec q rem =
+ match q.pat_desc with
+ | Tpat_or (p1, p2, _) -> (
+ try matcher_rec p1 rem with NoMatch -> matcher_rec p2 rem
+ )
+ | Tpat_construct (_, cstr', []) when Types.may_equal_constr cstr cstr'
+ ->
rem
- | _, _ -> assert false
- end
- | Tpat_construct (_, cstr', [arg])
- when Types.may_equal_constr cstr cstr' -> arg::rem
- | Tpat_any -> omega::rem
- | _ -> raise NoMatch in
- matcher_rec
-| _ ->
- fun q rem -> match q.pat_desc with
- | Tpat_or (_,_,_) -> raise OrPat
- | Tpat_construct (_,cstr',args)
- when Types.may_equal_constr cstr cstr' -> args @ rem
- | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
- | _ -> raise NoMatch
+ | Tpat_any -> rem
+ | _ -> raise NoMatch
+ in
+ matcher_rec
+ | 1 ->
+ let rec matcher_rec q rem =
+ match q.pat_desc with
+ | Tpat_or (p1, p2, _) -> (
+ (* if both sides of the or-pattern match the head constructor,
+ (K p1 | K p2) :: rem
+ return (p1 | p2) :: rem *)
+ let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
+ and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
+ match (r1, r2) with
+ | None, None -> raise NoMatch
+ | Some r1, None -> r1
+ | None, Some r2 -> r2
+ | Some (a1 :: _), Some (a2 :: _) ->
+ { a1 with
+ pat_loc = Location.none;
+ pat_desc = Tpat_or (a1, a2, None)
+ }
+ :: rem
+ | _, _ -> assert false
+ )
+ | Tpat_construct (_, cstr', [ arg ])
+ when Types.may_equal_constr cstr cstr' ->
+ arg :: rem
+ | Tpat_any -> omega :: rem
+ | _ -> raise NoMatch
+ in
+ matcher_rec
+ | _ -> (
+ fun q rem ->
+ match q.pat_desc with
+ | Tpat_or (_, _, _) ->
+ (* we cannot preserve the or-pattern as in the arity-1 case,
+ because we cannot express
+ (K (p1, .., pn) | K (q1, .. qn))
+ as (p1 .. pn | q1 .. qn) *)
+ raise OrPat
+ | Tpat_construct (_, cstr', args)
+ when Types.may_equal_constr cstr cstr' ->
+ args @ rem
+ | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
+ | _ -> raise NoMatch
+ )
let make_constr_matching p def ctx = function
- [] -> fatal_error "Matching.make_constr_matching"
- | ((arg, _mut) :: argl) ->
+ | [] -> fatal_error "Matching.make_constr_matching"
+ | (arg, _mut) :: argl ->
let cstr = pat_as_constr p in
let newargs =
if cstr.cstr_inlined <> None then
(arg, Alias) :: argl
- else match cstr.cstr_tag with
- Cstr_constant _ | Cstr_block _ ->
- make_field_args p.pat_loc Alias arg 0 (cstr.cstr_arity - 1) argl
- | Cstr_unboxed -> (arg, Alias) :: argl
- | Cstr_extension _ ->
- make_field_args p.pat_loc Alias arg 1 cstr.cstr_arity argl in
- {pm=
- {cases = []; args = newargs;
- default = make_default (matcher_constr cstr) def} ;
- ctx = filter_ctx p ctx ;
- pat=normalize_pat p}
-
+ else
+ match cstr.cstr_tag with
+ | Cstr_constant _
+ | Cstr_block _ ->
+ make_field_args p.pat_loc Alias arg 0 (cstr.cstr_arity - 1) argl
+ | Cstr_unboxed -> (arg, Alias) :: argl
+ | Cstr_extension _ ->
+ make_field_args p.pat_loc Alias arg 1 cstr.cstr_arity argl
+ in
+ { pm =
+ { cases = [];
+ args = newargs;
+ default = Default_environment.specialize (matcher_constr cstr) def
+ };
+ ctx = Context.specialize p ctx;
+ discr = normalize_pat p
+ }
let divide_constructor ctx pm =
- divide
- make_constr_matching
- (=) get_key_constr get_args_constr
- ctx pm
+ divide make_constr_matching ( = ) get_key_constr get_args_constr ctx pm
(* Matching against a variant *)
-let rec matcher_variant_const lab p rem = match p.pat_desc with
-| Tpat_or (p1, p2, _) ->
- begin
- try
- matcher_variant_const lab p1 rem
- with
- | NoMatch -> matcher_variant_const lab p2 rem
- end
-| Tpat_variant (lab1,_,_) when lab1=lab -> rem
-| Tpat_any -> rem
-| _ -> raise NoMatch
-
+let rec matcher_variant_const lab p rem =
+ match p.pat_desc with
+ | Tpat_or (p1, p2, _) -> (
+ try matcher_variant_const lab p1 rem
+ with NoMatch -> matcher_variant_const lab p2 rem
+ )
+ | Tpat_variant (lab1, _, _) when lab1 = lab -> rem
+ | Tpat_any -> rem
+ | _ -> raise NoMatch
let make_variant_matching_constant p lab def ctx = function
- [] -> fatal_error "Matching.make_variant_matching_constant"
- | (_ :: argl) ->
- let def = make_default (matcher_variant_const lab) def
- and ctx = filter_ctx p ctx in
- {pm={ cases = []; args = argl ; default=def} ;
- ctx=ctx ;
- pat = normalize_pat p}
-
-let matcher_variant_nonconst lab p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_variant (lab1,Some arg,_) when lab1=lab -> arg::rem
-| Tpat_any -> omega::rem
-| _ -> raise NoMatch
-
+ | [] -> fatal_error "Matching.make_variant_matching_constant"
+ | _ :: argl ->
+ let def = Default_environment.specialize (matcher_variant_const lab) def
+ and ctx = Context.specialize p ctx in
+ { pm = { cases = []; args = argl; default = def };
+ ctx;
+ discr = normalize_pat p
+ }
+
+let matcher_variant_nonconst lab p rem =
+ match p.pat_desc with
+ | Tpat_or (_, _, _) -> raise OrPat
+ | Tpat_variant (lab1, Some arg, _) when lab1 = lab -> arg :: rem
+ | Tpat_any -> omega :: rem
+ | _ -> raise NoMatch
let make_variant_matching_nonconst p lab def ctx = function
- [] -> fatal_error "Matching.make_variant_matching_nonconst"
- | ((arg, _mut) :: argl) ->
- let def = make_default (matcher_variant_nonconst lab) def
- and ctx = filter_ctx p ctx in
- {pm=
- {cases = []; args = (Lprim(Pfield 1, [arg], p.pat_loc), Alias) :: argl;
- default=def} ;
- ctx=ctx ;
- pat = normalize_pat p}
-
-let divide_variant row ctx {cases = cl; args = al; default=def} =
+ | [] -> fatal_error "Matching.make_variant_matching_nonconst"
+ | (arg, _mut) :: argl ->
+ let def =
+ Default_environment.specialize (matcher_variant_nonconst lab) def
+ and ctx = Context.specialize p ctx in
+ { pm =
+ { cases = [];
+ args = (Lprim (Pfield 1, [ arg ], p.pat_loc), Alias) :: argl;
+ default = def
+ };
+ ctx;
+ discr = normalize_pat p
+ }
+
+let divide_variant row ctx { cases = cl; args; default = def } =
let row = Btype.row_repr row in
let rec divide = function
- ({pat_desc = Tpat_variant(lab, pato, _)} as p:: patl, action) :: rem ->
+ | (({ pat_desc = Tpat_variant (lab, pato, _) } as p) :: patl, action)
+ :: rem -> (
let variants = divide rem in
- if try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent
- with Not_found -> true
+ if
+ try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent
+ with Not_found -> true
then
variants
- else begin
+ else
let tag = Btype.hash_variant lab in
match pato with
- None ->
- add (make_variant_matching_constant p lab def ctx) variants
- (=) (Cstr_constant tag) (patl, action) al
+ | None ->
+ add_in_div
+ (make_variant_matching_constant p lab def ctx)
+ ( = ) (Cstr_constant tag) (patl, action) variants
| Some pat ->
- add (make_variant_matching_nonconst p lab def ctx) variants
- (=) (Cstr_block tag) (pat :: patl, action) al
- end
- | _ -> []
+ add_in_div
+ (make_variant_matching_nonconst p lab def ctx)
+ ( = ) (Cstr_block tag)
+ (pat :: patl, action)
+ variants
+ )
+ | _ -> { args; cells = [] }
in
divide cl
*)
(* Matching against a variable *)
-
-let get_args_var _ rem = rem
-
+let get_args_var _p rem = rem
let make_var_matching def = function
- | [] -> fatal_error "Matching.make_var_matching"
- | _::argl ->
- {cases=[] ;
- args = argl ;
- default= make_default get_args_var def}
+ | [] -> fatal_error "Matching.make_var_matching"
+ | _ :: argl ->
+ { cases = [];
+ args = argl;
+ default = Default_environment.specialize get_args_var def
+ }
let divide_var ctx pm =
- divide_line ctx_lshift make_var_matching get_args_var omega ctx pm
+ divide_line Context.lshift make_var_matching get_args_var omega ctx pm
(* Matching and forcing a lazy value *)
-let get_arg_lazy p rem = match p with
-| {pat_desc = Tpat_any} -> omega :: rem
-| {pat_desc = Tpat_lazy arg} -> arg :: rem
-| _ -> assert false
+let get_arg_lazy p rem =
+ match p with
+ | { pat_desc = Tpat_any } -> omega :: rem
+ | { pat_desc = Tpat_lazy arg } -> arg :: rem
+ | _ -> assert false
-let matcher_lazy p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_any
-| Tpat_var _ -> omega :: rem
-| Tpat_lazy arg -> arg :: rem
-| _ -> raise NoMatch
+let matcher_lazy p rem =
+ match p.pat_desc with
+ | Tpat_or (_, _, _) -> raise OrPat
+ | Tpat_any
+ | Tpat_var _ ->
+ omega :: rem
+ | Tpat_lazy arg -> arg :: rem
+ | _ -> raise NoMatch
(* Inlining the tag tests before calling the primitive that works on
lazy blocks. This is also used in translcore.ml.
No other call than Obj.tag when the value has been forced before.
*)
-let prim_obj_tag =
- Primitive.simple ~name:"caml_obj_tag" ~arity:1 ~alloc:false
+let prim_obj_tag = Primitive.simple ~name:"caml_obj_tag" ~arity:1 ~alloc:false
let get_mod_field modname field =
- lazy (
- let mod_ident = Ident.create_persistent modname in
- let env = Env.add_persistent_structure mod_ident Env.initial_safe_string in
- match Env.open_pers_signature modname env with
- | exception Not_found -> fatal_error ("Module "^modname^" unavailable.")
- | env -> begin
- match Env.lookup_value (Longident.Lident field) env with
- | exception Not_found ->
- fatal_error ("Primitive "^modname^"."^field^" not found.")
- | (path, _) -> transl_value_path Location.none env path
- end
- )
-
-let code_force_lazy_block =
- get_mod_field "CamlinternalLazy" "force_lazy_block"
-let code_force_lazy =
- get_mod_field "CamlinternalLazy" "force"
-;;
+ lazy
+ (let mod_ident = Ident.create_persistent modname in
+ let env =
+ Env.add_persistent_structure mod_ident Env.initial_safe_string
+ in
+ match Env.open_pers_signature modname env with
+ | exception Not_found ->
+ fatal_error ("Module " ^ modname ^ " unavailable.")
+ | env -> (
+ match Env.find_value_by_name (Longident.Lident field) env with
+ | exception Not_found ->
+ fatal_error ("Primitive " ^ modname ^ "." ^ field ^ " not found.")
+ | path, _ -> transl_value_path Location.none env path
+ ))
+
+let code_force_lazy_block = get_mod_field "CamlinternalLazy" "force_lazy_block"
+
+let code_force_lazy = get_mod_field "CamlinternalLazy" "force"
(* inline_lazy_force inlines the beginning of the code of Lazy.force. When
the value argument is tagged as:
let idarg = Ident.create_local "lzarg" in
let varg = Lvar idarg in
let tag = Ident.create_local "tag" in
+ let tag_var = Lvar tag in
let force_fun = Lazy.force code_force_lazy_block in
- Llet(Strict, Pgenval, idarg, arg,
- Llet(Alias, Pgenval, tag, Lprim(Pccall prim_obj_tag, [varg], loc),
- Lifthenelse(
- (* if (tag == Obj.forward_tag) then varg.(0) else ... *)
- Lprim(Pintcomp Ceq,
- [Lvar tag; Lconst(Const_base(Const_int Obj.forward_tag))],
- loc),
- Lprim(Pfield 0, [varg], loc),
- Lifthenelse(
- (* ... if (tag == Obj.lazy_tag) then Lazy.force varg else ... *)
- Lprim(Pintcomp Ceq,
- [Lvar tag; Lconst(Const_base(Const_int Obj.lazy_tag))],
- loc),
- Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=force_fun;
- ap_args=[varg];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise},
- (* ... arg *)
- varg))))
+ Llet
+ ( Strict,
+ Pgenval,
+ idarg,
+ arg,
+ Llet
+ ( Alias,
+ Pgenval,
+ tag,
+ Lprim (Pccall prim_obj_tag, [ varg ], loc),
+ Lifthenelse
+ ( (* if (tag == Obj.forward_tag) then varg.(0) else ... *)
+ Lprim
+ ( Pintcomp Ceq,
+ [ tag_var; Lconst (Const_base (Const_int Obj.forward_tag)) ],
+ loc ),
+ Lprim (Pfield 0, [ varg ], loc),
+ Lifthenelse
+ ( (* if (tag == Obj.lazy_tag) then Lazy.force varg else ... *)
+ Lprim
+ ( Pintcomp Ceq,
+ [ tag_var; Lconst (Const_base (Const_int Obj.lazy_tag)) ],
+ loc ),
+ Lapply
+ { ap_should_be_tailcall = false;
+ ap_loc = loc;
+ ap_func = force_fun;
+ ap_args = [ varg ];
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise
+ },
+ (* ... arg *)
+ varg ) ) ) )
let inline_lazy_force_switch arg loc =
let idarg = Ident.create_local "lzarg" in
let varg = Lvar idarg in
let force_fun = Lazy.force code_force_lazy_block in
- Llet(Strict, Pgenval, idarg, arg,
- Lifthenelse(
- Lprim(Pisint, [varg], loc), varg,
- (Lswitch
- (varg,
- { sw_numconsts = 0; sw_consts = [];
- sw_numblocks = 256; (* PR#6033 - tag ranges from 0 to 255 *)
- sw_blocks =
- [ (Obj.forward_tag, Lprim(Pfield 0, [varg], loc));
- (Obj.lazy_tag,
- Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=force_fun;
- ap_args=[varg];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}) ];
- sw_failaction = Some varg }, loc ))))
+ Llet
+ ( Strict,
+ Pgenval,
+ idarg,
+ arg,
+ Lifthenelse
+ ( Lprim (Pisint, [ varg ], loc),
+ varg,
+ Lswitch
+ ( varg,
+ { sw_numconsts = 0;
+ sw_consts = [];
+ sw_numblocks = 256;
+ (* PR#6033 - tag ranges from 0 to 255 *)
+ sw_blocks =
+ [ (Obj.forward_tag, Lprim (Pfield 0, [ varg ], loc));
+ ( Obj.lazy_tag,
+ Lapply
+ { ap_should_be_tailcall = false;
+ ap_loc = loc;
+ ap_func = force_fun;
+ ap_args = [ varg ];
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise
+ } )
+ ];
+ sw_failaction = Some varg
+ },
+ loc ) ) )
let inline_lazy_force arg loc =
if !Clflags.afl_instrument then
so that the GC forwarding optimisation is not visible in the
instrumentation output.
(see https://github.com/stedolan/crowbar/issues/14) *)
- Lapply{ap_should_be_tailcall = false;
- ap_loc=loc;
- ap_func=Lazy.force code_force_lazy;
- ap_args=[arg];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ Lapply
+ { ap_should_be_tailcall = false;
+ ap_loc = loc;
+ ap_func = Lazy.force code_force_lazy;
+ ap_args = [ arg ];
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise
+ }
+ else if !Clflags.native_code then
+ (* Lswitch generates compact and efficient native code *)
+ inline_lazy_force_switch arg loc
else
- if !Clflags.native_code then
- (* Lswitch generates compact and efficient native code *)
- inline_lazy_force_switch arg loc
- else
- (* generating bytecode: Lswitch would generate too many rather big
+ (* generating bytecode: Lswitch would generate too many rather big
tables (~ 250 elts); conditionals are better *)
- inline_lazy_force_cond arg loc
+ inline_lazy_force_cond arg loc
let make_lazy_matching def = function
- [] -> fatal_error "Matching.make_lazy_matching"
- | (arg,_mut) :: argl ->
+ | [] -> fatal_error "Matching.make_lazy_matching"
+ | (arg, _mut) :: argl ->
{ cases = [];
- args =
- (inline_lazy_force arg Location.none, Strict) :: argl;
- default = make_default matcher_lazy def }
+ args = (inline_lazy_force arg Location.none, Strict) :: argl;
+ default = Default_environment.specialize matcher_lazy def
+ }
let divide_lazy p ctx pm =
- divide_line
- (filter_ctx p)
- make_lazy_matching
- get_arg_lazy
- p ctx pm
+ divide_line (Context.specialize p) make_lazy_matching get_arg_lazy p ctx pm
(* Matching against a tuple pattern *)
+let get_args_tuple arity p rem =
+ match p with
+ | { pat_desc = Tpat_any } -> omegas arity @ rem
+ | { pat_desc = Tpat_tuple args } -> args @ rem
+ | _ -> assert false
-let get_args_tuple arity p rem = match p with
-| {pat_desc = Tpat_any} -> omegas arity @ rem
-| {pat_desc = Tpat_tuple args} ->
- args @ rem
-| _ -> assert false
-
-let matcher_tuple arity p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_any
-| Tpat_var _ -> omegas arity @ rem
-| Tpat_tuple args when List.length args = arity -> args @ rem
-| _ -> raise NoMatch
+let matcher_tuple arity p rem =
+ match p.pat_desc with
+ | Tpat_or (_, _, _) -> raise OrPat
+ | Tpat_any
+ | Tpat_var _ ->
+ omegas arity @ rem
+ | Tpat_tuple args when List.length args = arity -> args @ rem
+ | _ -> raise NoMatch
let make_tuple_matching loc arity def = function
- [] -> fatal_error "Matching.make_tuple_matching"
+ | [] -> fatal_error "Matching.make_tuple_matching"
| (arg, _mut) :: argl ->
let rec make_args pos =
- if pos >= arity
- then argl
- else (Lprim(Pfield pos, [arg], loc), Alias) :: make_args (pos + 1) in
- {cases = []; args = make_args 0 ;
- default=make_default (matcher_tuple arity) def}
-
+ if pos >= arity then
+ argl
+ else
+ (Lprim (Pfield pos, [ arg ], loc), Alias) :: make_args (pos + 1)
+ in
+ { cases = [];
+ args = make_args 0;
+ default = Default_environment.specialize (matcher_tuple arity) def
+ }
let divide_tuple arity p ctx pm =
- divide_line
- (filter_ctx p)
+ divide_line (Context.specialize p)
(make_tuple_matching p.pat_loc arity)
- (get_args_tuple arity) p ctx pm
+ (get_args_tuple arity) p ctx pm
(* Matching against a record pattern *)
-
let record_matching_line num_fields lbl_pat_list =
let patv = Array.make num_fields omega in
List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list;
Array.to_list patv
-let get_args_record num_fields p rem = match p with
-| {pat_desc=Tpat_any} ->
- record_matching_line num_fields [] @ rem
-| {pat_desc=Tpat_record (lbl_pat_list,_)} ->
- record_matching_line num_fields lbl_pat_list @ rem
-| _ -> assert false
-
-let matcher_record num_fields p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_any
-| Tpat_var _ ->
- record_matching_line num_fields [] @ rem
-| Tpat_record ([], _) when num_fields = 0 -> rem
-| Tpat_record ((_, lbl, _) :: _ as lbl_pat_list, _)
- when Array.length lbl.lbl_all = num_fields ->
- record_matching_line num_fields lbl_pat_list @ rem
-| _ -> raise NoMatch
+let get_args_record num_fields p rem =
+ match p with
+ | { pat_desc = Tpat_any } -> record_matching_line num_fields [] @ rem
+ | { pat_desc = Tpat_record (lbl_pat_list, _) } ->
+ record_matching_line num_fields lbl_pat_list @ rem
+ | _ -> assert false
+
+let matcher_record num_fields p rem =
+ match p.pat_desc with
+ | Tpat_or (_, _, _) -> raise OrPat
+ | Tpat_any
+ | Tpat_var _ ->
+ record_matching_line num_fields [] @ rem
+ | Tpat_record ([], _) when num_fields = 0 -> rem
+ | Tpat_record (((_, lbl, _) :: _ as lbl_pat_list), _)
+ when Array.length lbl.lbl_all = num_fields ->
+ record_matching_line num_fields lbl_pat_list @ rem
+ | _ -> raise NoMatch
let make_record_matching loc all_labels def = function
- [] -> fatal_error "Matching.make_record_matching"
- | ((arg, _mut) :: argl) ->
+ | [] -> fatal_error "Matching.make_record_matching"
+ | (arg, _mut) :: argl ->
let rec make_args pos =
- if pos >= Array.length all_labels then argl else begin
+ if pos >= Array.length all_labels then
+ argl
+ else
let lbl = all_labels.(pos) in
let access =
match lbl.lbl_repres with
- | Record_regular | Record_inlined _ ->
- Lprim (Pfield lbl.lbl_pos, [arg], loc)
+ | Record_regular
+ | Record_inlined _ ->
+ Lprim (Pfield lbl.lbl_pos, [ arg ], loc)
| Record_unboxed _ -> arg
- | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [arg], loc)
- | Record_extension _ -> Lprim (Pfield (lbl.lbl_pos + 1), [arg], loc)
+ | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [ arg ], loc)
+ | Record_extension _ ->
+ Lprim (Pfield (lbl.lbl_pos + 1), [ arg ], loc)
in
let str =
match lbl.lbl_mut with
- Immutable -> Alias
- | Mutable -> StrictOpt in
- (access, str) :: make_args(pos + 1)
- end in
+ | Immutable -> Alias
+ | Mutable -> StrictOpt
+ in
+ (access, str) :: make_args (pos + 1)
+ in
let nfields = Array.length all_labels in
- let def= make_default (matcher_record nfields) def in
- {cases = []; args = make_args 0 ; default = def}
-
+ let def = Default_environment.specialize (matcher_record nfields) def in
+ { cases = []; args = make_args 0; default = def }
let divide_record all_labels p ctx pm =
let get_args = get_args_record (Array.length all_labels) in
- divide_line
- (filter_ctx p)
+ divide_line (Context.specialize p)
(make_record_matching p.pat_loc all_labels)
- get_args
- p ctx pm
+ get_args p ctx pm
(* Matching against an array pattern *)
let get_key_array = function
- | {pat_desc=Tpat_array patl} -> List.length patl
+ | { pat_desc = Tpat_array patl } -> List.length patl
| _ -> assert false
-let get_args_array p rem = match p with
-| {pat_desc=Tpat_array patl} -> patl@rem
-| _ -> assert false
+let get_args_array p rem =
+ match p with
+ | { pat_desc = Tpat_array patl } -> patl @ rem
+ | _ -> assert false
-let matcher_array len p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_array args when List.length args=len -> args @ rem
-| Tpat_any -> Parmatch.omegas len @ rem
-| _ -> raise NoMatch
+let matcher_array len p rem =
+ match p.pat_desc with
+ | Tpat_or (_, _, _) -> raise OrPat
+ | Tpat_array args when List.length args = len -> args @ rem
+ | Tpat_any -> Parmatch.omegas len @ rem
+ | _ -> raise NoMatch
let make_array_matching kind p def ctx = function
| [] -> fatal_error "Matching.make_array_matching"
- | ((arg, _mut) :: argl) ->
+ | (arg, _mut) :: argl ->
let len = get_key_array p in
let rec make_args pos =
- if pos >= len
- then argl
- else (Lprim(Parrayrefu kind,
- [arg; Lconst(Const_base(Const_int pos))],
- p.pat_loc),
- StrictOpt) :: make_args (pos + 1) in
- let def = make_default (matcher_array len) def
- and ctx = filter_ctx p ctx in
- {pm={cases = []; args = make_args 0 ; default = def} ;
- ctx=ctx ;
- pat = normalize_pat p}
+ if pos >= len then
+ argl
+ else
+ ( Lprim
+ ( Parrayrefu kind,
+ [ arg; Lconst (Const_base (Const_int pos)) ],
+ p.pat_loc ),
+ StrictOpt )
+ :: make_args (pos + 1)
+ in
+ let def = Default_environment.specialize (matcher_array len) def
+ and ctx = Context.specialize p ctx in
+ { pm = { cases = []; args = make_args 0; default = def };
+ ctx;
+ discr = normalize_pat p
+ }
let divide_array kind ctx pm =
- divide
- (make_array_matching kind)
- (=) get_key_array get_args_array ctx pm
-
+ divide (make_array_matching kind) ( = ) get_key_array get_args_array ctx pm
(*
Specific string test sequence
let strings_test_threshold = 8
let prim_string_notequal =
- Pccall(Primitive.simple
- ~name:"caml_string_notequal"
- ~arity:2
- ~alloc:false)
+ Pccall (Primitive.simple ~name:"caml_string_notequal" ~arity:2 ~alloc:false)
let prim_string_compare =
- Pccall(Primitive.simple
- ~name:"caml_string_compare"
- ~arity:2
- ~alloc:false)
-
-let bind_sw arg k = match arg with
-| Lvar _ -> k arg
-| _ ->
- let id = Ident.create_local "switch" in
- Llet (Strict,Pgenval,id,arg,k (Lvar id))
+ Pccall (Primitive.simple ~name:"caml_string_compare" ~arity:2 ~alloc:false)
+let bind_sw arg k =
+ match arg with
+ | Lvar _ -> k arg
+ | _ ->
+ let id = Ident.create_local "switch" in
+ Llet (Strict, Pgenval, id, arg, k (Lvar id))
(* Sequential equality tests *)
let make_string_test_sequence loc arg sw d =
- let d,sw = match d with
- | None ->
- begin match sw with
- | (_,d)::sw -> d,sw
- | [] -> assert false
- end
- | Some d -> d,sw in
- bind_sw arg
- (fun arg ->
+ let d, sw =
+ match d with
+ | None -> (
+ match sw with
+ | (_, d) :: sw -> (d, sw)
+ | [] -> assert false
+ )
+ | Some d -> (d, sw)
+ in
+ bind_sw arg (fun arg ->
List.fold_right
- (fun (s,lam) k ->
+ (fun (str, lam) k ->
Lifthenelse
- (Lprim
- (prim_string_notequal,
- [arg; Lconst (Const_immstring s)], loc),
- k,lam))
+ ( Lprim
+ ( prim_string_notequal,
+ [ arg; Lconst (Const_immstring str) ],
+ loc ),
+ k,
+ lam ))
sw d)
-let rec split k xs = match xs with
-| [] -> assert false
-| x0::xs ->
- if k <= 1 then [],x0,xs
- else
- let xs,y0,ys = split (k-2) xs in
- x0::xs,y0,ys
+let rec split k xs =
+ match xs with
+ | [] -> assert false
+ | x0 :: xs ->
+ if k <= 1 then
+ ([], x0, xs)
+ else
+ let xs, y0, ys = split (k - 2) xs in
+ (x0 :: xs, y0, ys)
-let zero_lam = Lconst (Const_base (Const_int 0))
+let zero_lam = Lconst (Const_base (Const_int 0))
let tree_way_test loc arg lt eq gt =
Lifthenelse
- (Lprim (Pintcomp Clt,[arg;zero_lam], loc),lt,
- Lifthenelse(Lprim (Pintcomp Clt,[zero_lam;arg], loc),gt,eq))
+ ( Lprim (Pintcomp Clt, [ arg; zero_lam ], loc),
+ lt,
+ Lifthenelse (Lprim (Pintcomp Clt, [ zero_lam; arg ], loc), gt, eq) )
(* Dichotomic tree *)
-
let rec do_make_string_test_tree loc arg sw delta d =
let len = List.length sw in
- if len <= strings_test_threshold+delta then
+ if len <= strings_test_threshold + delta then
make_string_test_sequence loc arg sw d
else
- let lt,(s,act),gt = split len sw in
+ let lt, (s, act), gt = split len sw in
bind_sw
- (Lprim
- (prim_string_compare,
- [arg; Lconst (Const_immstring s)], loc))
+ (Lprim (prim_string_compare, [ arg; Lconst (Const_immstring s) ], loc))
(fun r ->
tree_way_test loc r
(do_make_string_test_tree loc arg lt delta d)
(do_make_string_test_tree loc arg gt delta d))
(* Entry point *)
-let expand_stringswitch loc arg sw d = match d with
-| None ->
- bind_sw arg
- (fun arg -> do_make_string_test_tree loc arg sw 0 None)
-| Some e ->
- bind_sw arg
- (fun arg ->
- make_catch e
- (fun d -> do_make_string_test_tree loc arg sw 1 (Some d)))
+let expand_stringswitch loc arg sw d =
+ match d with
+ | None -> bind_sw arg (fun arg -> do_make_string_test_tree loc arg sw 0 None)
+ | Some e ->
+ bind_sw arg (fun arg ->
+ make_catch e (fun d ->
+ do_make_string_test_tree loc arg sw 1 (Some d)))
(**********************)
(* Generic test trees *)
(* Add handler, if shared *)
let handle_shared () =
let hs = ref (fun x -> x) in
- let handle_shared act = match act with
- | Switch.Single act -> act
- | Switch.Shared act ->
- let i,h = make_catch_delayed act in
- let ohs = !hs in
- hs := (fun act -> h (ohs act)) ;
- make_exit i in
- hs,handle_shared
-
+ let handle_shared act =
+ match act with
+ | Switch.Single act -> act
+ | Switch.Shared act ->
+ let i, h = make_catch_delayed act in
+ let ohs = !hs in
+ (hs := fun act -> h (ohs act));
+ make_exit i
+ in
+ (hs, handle_shared)
let share_actions_tree sw d =
let store = StoreExp.mk_store () in
-(* Default action is always shared *)
+ (* Default action is always shared *)
let d =
match d with
| None -> None
- | Some d -> Some (store.Switch.act_store_shared () d) in
-(* Store all other actions *)
+ | Some d -> Some (store.Switch.act_store_shared () d)
+ in
+ (* Store all other actions *)
let sw =
- List.map (fun (cst,act) -> cst,store.Switch.act_store () act) sw in
-
-(* Retrieve all actions, including potential default *)
+ List.map (fun (cst, act) -> (cst, store.Switch.act_store () act)) sw
+ in
+ (* Retrieve all actions, including potential default *)
let acts = store.Switch.act_get_shared () in
-
-(* Array of actual actions *)
- let hs,handle_shared = handle_shared () in
+ (* Array of actual actions *)
+ let hs, handle_shared = handle_shared () in
let acts = Array.map handle_shared acts in
-
-(* Reconstruct default and switch list *)
- let d = match d with
- | None -> None
- | Some d -> Some (acts.(d)) in
- let sw = List.map (fun (cst,j) -> cst,acts.(j)) sw in
- !hs,sw,d
+ (* Reconstruct default and switch list *)
+ let d =
+ match d with
+ | None -> None
+ | Some d -> Some acts.(d)
+ in
+ let sw = List.map (fun (cst, j) -> (cst, acts.(j))) sw in
+ (!hs, sw, d)
(* Note: dichotomic search requires sorted input with no duplicates *)
-let rec uniq_lambda_list sw = match sw with
- | []|[_] -> sw
- | (c1,_ as p1)::((c2,_)::sw2 as sw1) ->
- if const_compare c1 c2 = 0 then uniq_lambda_list (p1::sw2)
- else p1::uniq_lambda_list sw1
+let rec uniq_lambda_list sw =
+ match sw with
+ | []
+ | [ _ ] ->
+ sw
+ | ((c1, _) as p1) :: ((c2, _) :: sw2 as sw1) ->
+ if const_compare c1 c2 = 0 then
+ uniq_lambda_list (p1 :: sw2)
+ else
+ p1 :: uniq_lambda_list sw1
let sort_lambda_list l =
- let l =
- List.stable_sort (fun (x,_) (y,_) -> const_compare x y) l in
+ let l = List.stable_sort (fun (x, _) (y, _) -> const_compare x y) l in
uniq_lambda_list l
-let rec cut n l =
- if n = 0 then [],l
- else match l with
- [] -> raise (Invalid_argument "cut")
- | a::l -> let l1,l2 = cut (n-1) l in a::l1, l2
-
let rec do_tests_fail loc fail tst arg = function
| [] -> fail
- | (c, act)::rem ->
+ | (c, act) :: rem ->
Lifthenelse
- (Lprim (tst, [arg ; Lconst (Const_base c)], loc),
- do_tests_fail loc fail tst arg rem,
- act)
+ ( Lprim (tst, [ arg; Lconst (Const_base c) ], loc),
+ do_tests_fail loc fail tst arg rem,
+ act )
let rec do_tests_nofail loc tst arg = function
| [] -> fatal_error "Matching.do_tests_nofail"
- | [_,act] -> act
- | (c,act)::rem ->
+ | [ (_, act) ] -> act
+ | (c, act) :: rem ->
Lifthenelse
- (Lprim (tst, [arg ; Lconst (Const_base c)], loc),
- do_tests_nofail loc tst arg rem,
- act)
+ ( Lprim (tst, [ arg; Lconst (Const_base c) ], loc),
+ do_tests_nofail loc tst arg rem,
+ act )
let make_test_sequence loc fail tst lt_tst arg const_lambda_list =
let const_lambda_list = sort_lambda_list const_lambda_list in
- let hs,const_lambda_list,fail =
- share_actions_tree const_lambda_list fail in
-
+ let hs, const_lambda_list, fail =
+ share_actions_tree const_lambda_list fail
+ in
let rec make_test_sequence const_lambda_list =
if List.length const_lambda_list >= 4 && lt_tst <> Pignore then
split_sequence const_lambda_list
- else match fail with
- | None -> do_tests_nofail loc tst arg const_lambda_list
- | Some fail -> do_tests_fail loc fail tst arg const_lambda_list
-
+ else
+ match fail with
+ | None -> do_tests_nofail loc tst arg const_lambda_list
+ | Some fail -> do_tests_fail loc fail tst arg const_lambda_list
and split_sequence const_lambda_list =
let list1, list2 =
- cut (List.length const_lambda_list / 2) const_lambda_list in
- Lifthenelse(Lprim(lt_tst,
- [arg; Lconst(Const_base (fst(List.hd list2)))],
- loc),
- make_test_sequence list1, make_test_sequence list2)
+ rev_split_at (List.length const_lambda_list / 2) const_lambda_list
+ in
+ Lifthenelse
+ ( Lprim (lt_tst, [ arg; Lconst (Const_base (fst (List.hd list2))) ], loc),
+ make_test_sequence list1,
+ make_test_sequence list2 )
in
hs (make_test_sequence const_lambda_list)
-
module SArg = struct
type primitive = Lambda.primitive
let eqint = Pintcomp Ceq
+
let neint = Pintcomp Cne
+
let leint = Pintcomp Cle
+
let ltint = Pintcomp Clt
+
let geint = Pintcomp Cge
+
let gtint = Pintcomp Cgt
type act = Lambda.lambda
- let make_prim p args = Lprim (p,args,Location.none)
- let make_offset arg n = match n with
- | 0 -> arg
- | _ -> Lprim (Poffsetint n,[arg],Location.none)
+ let make_prim p args = Lprim (p, args, Location.none)
+
+ let make_offset arg n =
+ match n with
+ | 0 -> arg
+ | _ -> Lprim (Poffsetint n, [ arg ], Location.none)
let bind arg body =
- let newvar,newarg = match arg with
- | Lvar v -> v,arg
- | _ ->
- let newvar = Ident.create_local "switcher" in
- newvar,Lvar newvar in
+ let newvar, newarg =
+ match arg with
+ | Lvar v -> (v, arg)
+ | _ ->
+ let newvar = Ident.create_local "switcher" in
+ (newvar, Lvar newvar)
+ in
bind Alias newvar arg (body newarg)
+
let make_const i = Lconst (Const_base (Const_int i))
- let make_isout h arg = Lprim (Pisout, [h ; arg],Location.none)
- let make_isin h arg = Lprim (Pnot,[make_isout h arg],Location.none)
+
+ let make_isout h arg = Lprim (Pisout, [ h; arg ], Location.none)
+
+ let make_isin h arg = Lprim (Pnot, [ make_isout h arg ], Location.none)
+
let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
+
let make_switch loc arg cases acts =
let l = ref [] in
- for i = Array.length cases-1 downto 0 do
- l := (i,acts.(cases.(i))) :: !l
- done ;
- Lswitch(arg,
- {sw_numconsts = Array.length cases ; sw_consts = !l ;
- sw_numblocks = 0 ; sw_blocks = [] ;
- sw_failaction = None}, loc)
- let make_catch = make_catch_delayed
- let make_exit = make_exit
+ for i = Array.length cases - 1 downto 0 do
+ l := (i, acts.(cases.(i))) :: !l
+ done;
+ Lswitch
+ ( arg,
+ { sw_numconsts = Array.length cases;
+ sw_consts = !l;
+ sw_numblocks = 0;
+ sw_blocks = [];
+ sw_failaction = None
+ },
+ loc )
+
+ let make_catch = make_catch_delayed
+ let make_exit = make_exit
end
(* Action sharing for Lswitch argument *)
let share_actions_sw sw =
-(* Attempt sharing on all actions *)
+ (* Attempt sharing on all actions *)
let store = StoreExp.mk_store () in
- let fail = match sw.sw_failaction with
- | None -> None
- | Some fail ->
- (* Fail is translated to exit, whatever happens *)
- Some (store.Switch.act_store_shared () fail) in
+ let fail =
+ match sw.sw_failaction with
+ | None -> None
+ | Some fail ->
+ (* Fail is translated to exit, whatever happens *)
+ Some (store.Switch.act_store_shared () fail)
+ in
let consts =
- List.map
- (fun (i,e) -> i,store.Switch.act_store () e)
- sw.sw_consts
+ List.map (fun (i, e) -> (i, store.Switch.act_store () e)) sw.sw_consts
and blocks =
- List.map
- (fun (i,e) -> i,store.Switch.act_store () e)
- sw.sw_blocks in
+ List.map (fun (i, e) -> (i, store.Switch.act_store () e)) sw.sw_blocks
+ in
let acts = store.Switch.act_get_shared () in
- let hs,handle_shared = handle_shared () in
+ let hs, handle_shared = handle_shared () in
let acts = Array.map handle_shared acts in
- let fail = match fail with
- | None -> None
- | Some fail -> Some (acts.(fail)) in
- !hs,
- { sw with
- sw_consts = List.map (fun (i,j) -> i,acts.(j)) consts ;
- sw_blocks = List.map (fun (i,j) -> i,acts.(j)) blocks ;
- sw_failaction = fail; }
+ let fail =
+ match fail with
+ | None -> None
+ | Some fail -> Some acts.(fail)
+ in
+ ( !hs,
+ { sw with
+ sw_consts = List.map (fun (i, j) -> (i, acts.(j))) consts;
+ sw_blocks = List.map (fun (i, j) -> (i, acts.(j))) blocks;
+ sw_failaction = fail
+ } )
(* Reintroduce fail action in switch argument,
for the sake of avoiding carrying over huge switches *)
-let reintroduce_fail sw = match sw.sw_failaction with
-| None ->
- let t = Hashtbl.create 17 in
- let seen (_,l) = match as_simple_exit l with
- | Some i ->
- let old = try Hashtbl.find t i with Not_found -> 0 in
- Hashtbl.replace t i (old+1)
- | None -> () in
- List.iter seen sw.sw_consts ;
- List.iter seen sw.sw_blocks ;
- let i_max = ref (-1)
- and max = ref (-1) in
- Hashtbl.iter
- (fun i c ->
- if c > !max then begin
- i_max := i ;
- max := c
- end) t ;
- if !max >= 3 then
- let default = !i_max in
- let remove =
- List.filter
- (fun (_,lam) -> match as_simple_exit lam with
- | Some j -> j <> default
- | None -> true) in
- {sw with
- sw_consts = remove sw.sw_consts ;
- sw_blocks = remove sw.sw_blocks ;
- sw_failaction = Some (make_exit default)}
- else sw
-| Some _ -> sw
-
-
-module Switcher = Switch.Make(SArg)
+let reintroduce_fail sw =
+ match sw.sw_failaction with
+ | None ->
+ let t = Hashtbl.create 17 in
+ let seen (_, l) =
+ match as_simple_exit l with
+ | Some i ->
+ let old = try Hashtbl.find t i with Not_found -> 0 in
+ Hashtbl.replace t i (old + 1)
+ | None -> ()
+ in
+ List.iter seen sw.sw_consts;
+ List.iter seen sw.sw_blocks;
+ let i_max = ref (-1) and max = ref (-1) in
+ Hashtbl.iter
+ (fun i c ->
+ if c > !max then (
+ i_max := i;
+ max := c
+ ))
+ t;
+ if !max >= 3 then
+ let default = !i_max in
+ let remove =
+ List.filter (fun (_, lam) ->
+ match as_simple_exit lam with
+ | Some j -> j <> default
+ | None -> true)
+ in
+ { sw with
+ sw_consts = remove sw.sw_consts;
+ sw_blocks = remove sw.sw_blocks;
+ sw_failaction = Some (make_exit default)
+ }
+ else
+ sw
+ | Some _ -> sw
+
+module Switcher = Switch.Make (SArg)
open Switch
let rec last def = function
| [] -> def
- | [x,_] -> x
- | _::rem -> last def rem
-
-let get_edges low high l = match l with
-| [] -> low, high
-| (x,_)::_ -> x, last high l
+ | [ (x, _) ] -> x
+ | _ :: rem -> last def rem
+let get_edges low high l =
+ match l with
+ | [] -> (low, high)
+ | (x, _) :: _ -> (x, last high l)
let as_interval_canfail fail low high l =
let store = StoreExp.mk_store () in
-
let do_store _tag act =
-
- let i = store.act_store () act in
-(*
+ let i = store.act_store () act in
+ (*
eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ;
*)
- i in
-
+ i
+ in
let rec nofail_rec cur_low cur_high cur_act = function
| [] ->
if cur_high = high then
- [cur_low,cur_high,cur_act]
+ [ (cur_low, cur_high, cur_act) ]
else
- [(cur_low,cur_high,cur_act) ; (cur_high+1,high, 0)]
- | ((i,act_i)::rem) as all ->
+ [ (cur_low, cur_high, cur_act); (cur_high + 1, high, 0) ]
+ | (i, act_i) :: rem as all ->
let act_index = do_store "NO" act_i in
- if cur_high+1= i then
- if act_index=cur_act then
+ if cur_high + 1 = i then
+ if act_index = cur_act then
nofail_rec cur_low i cur_act rem
- else if act_index=0 then
- (cur_low,i-1, cur_act)::fail_rec i i rem
+ else if act_index = 0 then
+ (cur_low, i - 1, cur_act) :: fail_rec i i rem
else
- (cur_low, i-1, cur_act)::nofail_rec i i act_index rem
+ (cur_low, i - 1, cur_act) :: nofail_rec i i act_index rem
else if act_index = 0 then
- (cur_low, cur_high, cur_act)::
- fail_rec (cur_high+1) (cur_high+1) all
+ (cur_low, cur_high, cur_act)
+ :: fail_rec (cur_high + 1) (cur_high + 1) all
else
- (cur_low, cur_high, cur_act)::
- (cur_high+1,i-1,0)::
- nofail_rec i i act_index rem
-
+ (cur_low, cur_high, cur_act)
+ :: (cur_high + 1, i - 1, 0)
+ :: nofail_rec i i act_index rem
and fail_rec cur_low cur_high = function
- | [] -> [(cur_low, cur_high, 0)]
- | (i,act_i)::rem ->
+ | [] -> [ (cur_low, cur_high, 0) ]
+ | (i, act_i) :: rem ->
let index = do_store "YES" act_i in
- if index=0 then fail_rec cur_low i rem
+ if index = 0 then
+ fail_rec cur_low i rem
else
- (cur_low,i-1,0)::
- nofail_rec i i index rem in
-
+ (cur_low, i - 1, 0) :: nofail_rec i i index rem
+ in
let init_rec = function
- | [] -> [low,high,0]
- | (i,act_i)::rem ->
+ | [] -> [ (low, high, 0) ]
+ | (i, act_i) :: rem ->
let index = do_store "INIT" act_i in
- if index=0 then
+ if index = 0 then
fail_rec low i rem
+ else if low < i then
+ (low, i - 1, 0) :: nofail_rec i i index rem
else
- if low < i then
- (low,i-1,0)::nofail_rec i i index rem
- else
- nofail_rec i i index rem in
+ nofail_rec i i index rem
+ in
+ assert (do_store "FAIL" fail = 0);
- assert (do_store "FAIL" fail = 0) ; (* fail has action index 0 *)
+ (* fail has action index 0 *)
let r = init_rec l in
- Array.of_list r, store
+ (Array.of_list r, store)
let as_interval_nofail l =
let store = StoreExp.mk_store () in
let rec some_hole = function
- | []|[_] -> false
- | (i,_)::((j,_)::_ as rem) ->
- j > i+1 || some_hole rem in
+ | []
+ | [ _ ] ->
+ false
+ | (i, _) :: ((j, _) :: _ as rem) -> j > i + 1 || some_hole rem
+ in
let rec i_rec cur_low cur_high cur_act = function
- | [] ->
- [cur_low, cur_high, cur_act]
- | (i,act)::rem ->
+ | [] -> [ (cur_low, cur_high, cur_act) ]
+ | (i, act) :: rem ->
let act_index = store.act_store () act in
if act_index = cur_act then
i_rec cur_low i cur_act rem
else
- (cur_low, cur_high, cur_act)::
- i_rec i i act_index rem in
- let inters = match l with
- | (i,act)::rem ->
- let act_index =
- (* In case there is some hole and that a switch is emitted,
+ (cur_low, cur_high, cur_act) :: i_rec i i act_index rem
+ in
+ let inters =
+ match l with
+ | (i, act) :: rem ->
+ let act_index =
+ (* In case there is some hole and that a switch is emitted,
action 0 will be used as the action of unreachable
cases (cf. switch.ml, make_switch).
Hence, this action will be shared *)
- if some_hole rem then
- store.act_store_shared () act
- else
- store.act_store () act in
- assert (act_index = 0) ;
- i_rec i i act_index rem
- | _ -> assert false in
-
- Array.of_list inters, store
-
+ if some_hole rem then
+ store.act_store_shared () act
+ else
+ store.act_store () act
+ in
+ assert (act_index = 0);
+ i_rec i i act_index rem
+ | _ -> assert false
+ in
+ (Array.of_list inters, store)
let sort_int_lambda_list l =
List.sort
- (fun (i1,_) (i2,_) ->
- if i1 < i2 then -1
- else if i2 < i1 then 1
- else 0)
+ (fun (i1, _) (i2, _) ->
+ if i1 < i2 then
+ -1
+ else if i2 < i1 then
+ 1
+ else
+ 0)
l
let as_interval fail low high l =
let l = sort_int_lambda_list l in
- get_edges low high l,
- (match fail with
- | None -> as_interval_nofail l
- | Some act -> as_interval_canfail act low high l)
+ ( get_edges low high l,
+ match fail with
+ | None -> as_interval_nofail l
+ | Some act -> as_interval_canfail act low high l )
let call_switcher loc fail arg low high int_lambda_list =
- let edges, (cases, actions) =
- as_interval fail low high int_lambda_list in
+ let edges, (cases, actions) = as_interval fail low high int_lambda_list in
Switcher.zyva loc edges arg cases actions
-
let rec list_as_pat = function
| [] -> fatal_error "Matching.list_as_pat"
- | [pat] -> pat
- | pat::rem ->
- {pat with pat_desc = Tpat_or (pat,list_as_pat rem,None)}
-
+ | [ pat ] -> pat
+ | pat :: rem -> { pat with pat_desc = Tpat_or (pat, list_as_pat rem, None) }
let complete_pats_constrs = function
- | p::_ as pats ->
- List.map
- (pat_of_constr p)
+ | p :: _ as pats ->
+ List.map (pat_of_constr p)
(complete_constrs p (List.map get_key_constr pats))
| _ -> assert false
-
(*
Following two ``failaction'' function compute n, the trap handler
to jump to in case of failure of elementary tests
*)
-let mk_failaction_neg partial ctx def = match partial with
-| Partial ->
- begin match def with
- | (_,idef)::_ ->
- Some (Lstaticraise (idef,[])),jumps_singleton idef ctx
- | [] ->
- (* Act as Total, this means
+let mk_failaction_neg partial ctx def =
+ match partial with
+ | Partial -> (
+ match Default_environment.pop def with
+ | Some ((_, idef), _) ->
+ (Some (Lstaticraise (idef, [])), Jumps.singleton idef ctx)
+ | None ->
+ (* Act as Total, this means
If no appropriate default matrix exists,
then this switch cannot fail *)
- None, jumps_empty
- end
-| Total ->
- None, jumps_empty
-
-
+ (None, Jumps.empty)
+ )
+ | Total -> (None, Jumps.empty)
(* In line with the article and simpler than before *)
-let mk_failaction_pos partial seen ctx defs =
- if dbg then begin
- Format.eprintf "**POS**\n" ;
- pretty_def defs ;
+let mk_failaction_pos partial seen ctx defs =
+ if dbg then (
+ Format.eprintf "**POS**\n";
+ Default_environment.pp defs;
()
- end ;
- let rec scan_def env to_test defs = match to_test,defs with
- | ([],_)|(_,[]) ->
- List.fold_left
- (fun (klist,jumps) (pats,i)->
- let action = Lstaticraise (i,[]) in
- let klist =
- List.fold_right
- (fun pat r -> (get_key_constr pat,action)::r)
- pats klist
- and jumps =
- jumps_add i (ctx_lub (list_as_pat pats) ctx) jumps in
- klist,jumps)
- ([],jumps_empty) env
- | _,(pss,idef)::rem ->
- let now, later =
- List.partition
- (fun (_p,p_ctx) -> ctx_match p_ctx pss) to_test in
- match now with
- | [] -> scan_def env to_test rem
- | _ -> scan_def ((List.map fst now,idef)::env) later rem in
-
+ );
+ let rec scan_def env to_test defs =
+ match (to_test, Default_environment.pop defs) with
+ | [], _
+ | _, None ->
+ List.fold_left
+ (fun (klist, jumps) (pats, i) ->
+ let action = Lstaticraise (i, []) in
+ let klist =
+ List.fold_right
+ (fun pat r -> (get_key_constr pat, action) :: r)
+ pats klist
+ and jumps =
+ Jumps.add i (Context.lub (list_as_pat pats) ctx) jumps
+ in
+ (klist, jumps))
+ ([], Jumps.empty) env
+ | _, Some ((pss, idef), rem) -> (
+ let now, later =
+ List.partition (fun (_p, p_ctx) -> Context.matches p_ctx pss) to_test
+ in
+ match now with
+ | [] -> scan_def env to_test rem
+ | _ -> scan_def ((List.map fst now, idef) :: env) later rem
+ )
+ in
let fail_pats = complete_pats_constrs seen in
- if List.length fail_pats < !Clflags.match_context_rows then begin
- let fail,jmps =
- scan_def
- []
- (List.map
- (fun pat -> pat, ctx_lub pat ctx)
- fail_pats)
- defs in
- if dbg then begin
+ if List.length fail_pats < !Clflags.match_context_rows then (
+ let fail, jmps =
+ scan_def []
+ (List.map (fun pat -> (pat, Context.lub pat ctx)) fail_pats)
+ defs
+ in
+ if dbg then (
eprintf "POSITIVE JUMPS [%i]:\n" (List.length fail_pats);
- pretty_jumps jmps
- end ;
- None,fail,jmps
- end else begin (* Too many non-matched constructors -> reduced information *)
- if dbg then eprintf "POS->NEG!!!\n%!" ;
- let fail,jumps = mk_failaction_neg partial ctx defs in
+ Jumps.eprintf jmps
+ );
+ (None, fail, jmps)
+ ) else (
+ (* Too many non-matched constructors -> reduced information *)
+ if dbg then eprintf "POS->NEG!!!\n%!";
+ let fail, jumps = mk_failaction_neg partial ctx defs in
if dbg then
eprintf "FAIL: %s\n"
- (match fail with
+ ( match fail with
| None -> "<none>"
- | Some lam -> string_of_lam lam) ;
- fail,[],jumps
- end
+ | Some lam -> string_of_lam lam
+ );
+ (fail, [], jumps)
+ )
let combine_constant loc arg cst partial ctx def
(const_lambda_list, total, _pats) =
- let fail, local_jumps =
- mk_failaction_neg partial ctx def in
+ let fail, local_jumps = mk_failaction_neg partial ctx def in
let lambda1 =
match cst with
| Const_int _ ->
let int_lambda_list =
- List.map (function Const_int n, l -> n,l | _ -> assert false)
- const_lambda_list in
+ List.map
+ (function
+ | Const_int n, l -> (n, l)
+ | _ -> assert false)
+ const_lambda_list
+ in
call_switcher loc fail arg min_int max_int int_lambda_list
| Const_char _ ->
let int_lambda_list =
- List.map (function Const_char c, l -> (Char.code c, l)
- | _ -> assert false)
- const_lambda_list in
+ List.map
+ (function
+ | Const_char c, l -> (Char.code c, l)
+ | _ -> assert false)
+ const_lambda_list
+ in
call_switcher loc fail arg 0 255 int_lambda_list
| Const_string _ ->
-(* Note as the bytecode compiler may resort to dichotomic search,
+ (* Note as the bytecode compiler may resort to dichotomic search,
the clauses of stringswitch are sorted with duplicates removed.
This partly applies to the native code compiler, which requires
no duplicates *)
let const_lambda_list = sort_lambda_list const_lambda_list in
let sw =
List.map
- (fun (c,act) -> match c with
- | Const_string (s,_) -> s,act
- | _ -> assert false)
- const_lambda_list in
- let hs,sw,fail = share_actions_tree sw fail in
- hs (Lstringswitch (arg,sw,fail,loc))
+ (fun (c, act) ->
+ match c with
+ | Const_string (s, _) -> (s, act)
+ | _ -> assert false)
+ const_lambda_list
+ in
+ let hs, sw, fail = share_actions_tree sw fail in
+ hs (Lstringswitch (arg, sw, fail, loc))
| Const_float _ ->
- make_test_sequence loc
- fail
- (Pfloatcomp CFneq) (Pfloatcomp CFlt)
- arg const_lambda_list
+ make_test_sequence loc fail (Pfloatcomp CFneq) (Pfloatcomp CFlt) arg
+ const_lambda_list
| Const_int32 _ ->
- make_test_sequence loc
- fail
- (Pbintcomp(Pint32, Cne)) (Pbintcomp(Pint32, Clt))
+ make_test_sequence loc fail
+ (Pbintcomp (Pint32, Cne))
+ (Pbintcomp (Pint32, Clt))
arg const_lambda_list
| Const_int64 _ ->
- make_test_sequence loc
- fail
- (Pbintcomp(Pint64, Cne)) (Pbintcomp(Pint64, Clt))
+ make_test_sequence loc fail
+ (Pbintcomp (Pint64, Cne))
+ (Pbintcomp (Pint64, Clt))
arg const_lambda_list
| Const_nativeint _ ->
- make_test_sequence loc
- fail
- (Pbintcomp(Pnativeint, Cne)) (Pbintcomp(Pnativeint, Clt))
+ make_test_sequence loc fail
+ (Pbintcomp (Pnativeint, Cne))
+ (Pbintcomp (Pnativeint, Clt))
arg const_lambda_list
- in lambda1,jumps_union local_jumps total
-
-
+ in
+ (lambda1, Jumps.union local_jumps total)
let split_cases tag_lambda_list =
let rec split_rec = function
- [] -> ([], [])
- | (cstr, act) :: rem ->
- let (consts, nonconsts) = split_rec rem in
+ | [] -> ([], [])
+ | (cstr, act) :: rem -> (
+ let consts, nonconsts = split_rec rem in
match cstr with
- Cstr_constant n -> ((n, act) :: consts, nonconsts)
- | Cstr_block n -> (consts, (n, act) :: nonconsts)
- | Cstr_unboxed -> (consts, (0, act) :: nonconsts)
- | Cstr_extension _ -> assert false in
+ | Cstr_constant n -> ((n, act) :: consts, nonconsts)
+ | Cstr_block n -> (consts, (n, act) :: nonconsts)
+ | Cstr_unboxed -> (consts, (0, act) :: nonconsts)
+ | Cstr_extension _ -> assert false
+ )
+ in
let const, nonconst = split_rec tag_lambda_list in
- sort_int_lambda_list const,
- sort_int_lambda_list nonconst
+ (sort_int_lambda_list const, sort_int_lambda_list nonconst)
let split_extension_cases tag_lambda_list =
let rec split_rec = function
- [] -> ([], [])
- | (cstr, act) :: rem ->
- let (consts, nonconsts) = split_rec rem in
+ | [] -> ([], [])
+ | (cstr, act) :: rem -> (
+ let consts, nonconsts = split_rec rem in
match cstr with
- Cstr_extension(path, true) -> ((path, act) :: consts, nonconsts)
- | Cstr_extension(path, false) -> (consts, (path, act) :: nonconsts)
- | _ -> assert false in
+ | Cstr_extension (path, true) -> ((path, act) :: consts, nonconsts)
+ | Cstr_extension (path, false) -> (consts, (path, act) :: nonconsts)
+ | _ -> assert false
+ )
+ in
split_rec tag_lambda_list
-
let combine_constructor loc arg ex_pat cstr partial ctx def
(tag_lambda_list, total1, pats) =
- if cstr.cstr_consts < 0 then begin
- (* Special cases for extensions *)
- let fail, local_jumps =
- mk_failaction_neg partial ctx def in
- let lambda1 =
- let consts, nonconsts = split_extension_cases tag_lambda_list in
- let default, consts, nonconsts =
- match fail with
- | None ->
- begin match consts, nonconsts with
- | _, (_, act)::rem -> act, consts, rem
- | (_, act)::rem, _ -> act, rem, nonconsts
- | _ -> assert false
- end
- | Some fail -> fail, consts, nonconsts in
- let nonconst_lambda =
- match nonconsts with
- [] -> default
- | _ ->
- let tag = Ident.create_local "tag" in
- let tests =
- List.fold_right
- (fun (path, act) rem ->
- let ext = transl_extension_path loc ex_pat.pat_env path in
- Lifthenelse(Lprim(Pintcomp Ceq, [Lvar tag; ext], loc),
- act, rem))
- nonconsts
- default
- in
- Llet(Alias, Pgenval,tag, Lprim(Pfield 0, [arg], loc), tests)
- in
+ match cstr.cstr_tag with
+ | Cstr_extension _ ->
+ (* Special cases for extensions *)
+ let fail, local_jumps = mk_failaction_neg partial ctx def in
+ let lambda1 =
+ let consts, nonconsts = split_extension_cases tag_lambda_list in
+ let default, consts, nonconsts =
+ match fail with
+ | None -> (
+ match (consts, nonconsts) with
+ | _, (_, act) :: rem -> (act, consts, rem)
+ | (_, act) :: rem, _ -> (act, rem, nonconsts)
+ | _ -> assert false
+ )
+ | Some fail -> (fail, consts, nonconsts)
+ in
+ let nonconst_lambda =
+ match nonconsts with
+ | [] -> default
+ | _ ->
+ let tag = Ident.create_local "tag" in
+ let tests =
+ List.fold_right
+ (fun (path, act) rem ->
+ let ext = transl_extension_path loc ex_pat.pat_env path in
+ Lifthenelse
+ (Lprim (Pintcomp Ceq, [ Lvar tag; ext ], loc), act, rem))
+ nonconsts default
+ in
+ Llet (Alias, Pgenval, tag, Lprim (Pfield 0, [ arg ], loc), tests)
+ in
List.fold_right
(fun (path, act) rem ->
- let ext = transl_extension_path loc ex_pat.pat_env path in
- Lifthenelse(Lprim(Pintcomp Ceq, [arg; ext], loc),
- act, rem))
- consts
- nonconst_lambda
- in
- lambda1, jumps_union local_jumps total1
- end else begin
- (* Regular concrete type *)
- let ncases = List.length tag_lambda_list
- and nconstrs = cstr.cstr_consts + cstr.cstr_nonconsts in
- let sig_complete = ncases = nconstrs in
- let fail_opt,fails,local_jumps =
- if sig_complete then None,[],jumps_empty
- else
- mk_failaction_pos partial pats ctx def in
-
- let tag_lambda_list = fails @ tag_lambda_list in
- let (consts, nonconsts) = split_cases tag_lambda_list in
- let lambda1 =
- match fail_opt,same_actions tag_lambda_list with
- | None,Some act -> act (* Identical actions, no failure *)
- | _ ->
- match
- (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
- with
- | (1, 1, [0, act1], [0, act2]) ->
- (* Typically, match on lists, will avoid isint primitive in that
+ let ext = transl_extension_path loc ex_pat.pat_env path in
+ Lifthenelse (Lprim (Pintcomp Ceq, [ arg; ext ], loc), act, rem))
+ consts nonconst_lambda
+ in
+ (lambda1, Jumps.union local_jumps total1)
+ | _ ->
+ (* Regular concrete type *)
+ let ncases = List.length tag_lambda_list
+ and nconstrs = cstr.cstr_consts + cstr.cstr_nonconsts in
+ let sig_complete = ncases = nconstrs in
+ let fail_opt, fails, local_jumps =
+ if sig_complete then
+ (None, [], Jumps.empty)
+ else
+ mk_failaction_pos partial pats ctx def
+ in
+ let tag_lambda_list = fails @ tag_lambda_list in
+ let consts, nonconsts = split_cases tag_lambda_list in
+ let lambda1 =
+ match (fail_opt, same_actions tag_lambda_list) with
+ | None, Some act -> act (* Identical actions, no failure *)
+ | _ -> (
+ match
+ (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
+ with
+ | 1, 1, [ (0, act1) ], [ (0, act2) ] ->
+ (* Typically, match on lists, will avoid isint primitive in that
case *)
- Lifthenelse(arg, act2, act1)
- | (n,0,_,[]) -> (* The type defines constant constructors only *)
- call_switcher loc fail_opt arg 0 (n-1) consts
- | (n, _, _, _) ->
- let act0 =
- (* = Some act when all non-const constructors match to act *)
- match fail_opt,nonconsts with
- | Some a,[] -> Some a
- | Some _,_ ->
- if List.length nonconsts = cstr.cstr_nonconsts then
- same_actions nonconsts
- else None
- | None,_ -> same_actions nonconsts in
- match act0 with
- | Some act ->
- Lifthenelse
- (Lprim (Pisint, [arg], loc),
- call_switcher loc
- fail_opt arg
- 0 (n-1) consts,
- act)
-(* Emit a switch, as bytecode implements this sophisticated instruction *)
- | None ->
- let sw =
- {sw_numconsts = cstr.cstr_consts; sw_consts = consts;
- sw_numblocks = cstr.cstr_nonconsts; sw_blocks = nonconsts;
- sw_failaction = fail_opt} in
- let hs,sw = share_actions_sw sw in
- let sw = reintroduce_fail sw in
- hs (Lswitch (arg,sw,loc)) in
- lambda1, jumps_union local_jumps total1
- end
+ Lifthenelse (arg, act2, act1)
+ | n, 0, _, [] ->
+ (* The type defines constant constructors only *)
+ call_switcher loc fail_opt arg 0 (n - 1) consts
+ | n, _, _, _ -> (
+ let act0 =
+ (* = Some act when all non-const constructors match to act *)
+ match (fail_opt, nonconsts) with
+ | Some a, [] -> Some a
+ | Some _, _ ->
+ if List.length nonconsts = cstr.cstr_nonconsts then
+ same_actions nonconsts
+ else
+ None
+ | None, _ -> same_actions nonconsts
+ in
+ match act0 with
+ | Some act ->
+ Lifthenelse
+ ( Lprim (Pisint, [ arg ], loc),
+ call_switcher loc fail_opt arg 0 (n - 1) consts,
+ act )
+ | None ->
+ (* Emit a switch, as bytecode implements this sophisticated
+ instruction *)
+ let sw =
+ { sw_numconsts = cstr.cstr_consts;
+ sw_consts = consts;
+ sw_numblocks = cstr.cstr_nonconsts;
+ sw_blocks = nonconsts;
+ sw_failaction = fail_opt
+ }
+ in
+ let hs, sw = share_actions_sw sw in
+ let sw = reintroduce_fail sw in
+ hs (Lswitch (arg, sw, loc))
+ )
+ )
+ in
+ (lambda1, Jumps.union local_jumps total1)
let make_test_sequence_variant_constant fail arg int_lambda_list =
- let _, (cases, actions) =
- as_interval fail min_int max_int int_lambda_list in
+ let _, (cases, actions) = as_interval fail min_int max_int int_lambda_list in
Switcher.test_sequence arg cases actions
let call_switcher_variant_constant loc fail arg int_lambda_list =
call_switcher loc fail arg min_int max_int int_lambda_list
-
let call_switcher_variant_constr loc fail arg int_lambda_list =
let v = Ident.create_local "variant" in
- Llet(Alias, Pgenval, v, Lprim(Pfield 0, [arg], loc),
- call_switcher loc
- fail (Lvar v) min_int max_int int_lambda_list)
-
-let combine_variant loc row arg partial ctx def
- (tag_lambda_list, total1, _pats) =
+ Llet
+ ( Alias,
+ Pgenval,
+ v,
+ Lprim (Pfield 0, [ arg ], loc),
+ call_switcher loc fail (Lvar v) min_int max_int int_lambda_list )
+
+let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, _pats)
+ =
let row = Btype.row_repr row in
let num_constr = ref 0 in
if row.row_closed then
List.iter
(fun (_, f) ->
match Btype.row_field_repr f with
- Rabsent | Reither(true, _::_, _, _) -> ()
+ | Rabsent
+ | Reither (true, _ :: _, _, _) ->
+ ()
| _ -> incr num_constr)
row.row_fields
else
num_constr := max_int;
let test_int_or_block arg if_int if_block =
- Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in
- let sig_complete = List.length tag_lambda_list = !num_constr
+ Lifthenelse (Lprim (Pisint, [ arg ], loc), if_int, if_block)
+ in
+ let sig_complete = List.length tag_lambda_list = !num_constr
and one_action = same_actions tag_lambda_list in
let fail, local_jumps =
if
- sig_complete || (match partial with Total -> true | _ -> false)
+ sig_complete
+ ||
+ match partial with
+ | Total -> true
+ | _ -> false
then
- None, jumps_empty
+ (None, Jumps.empty)
else
- mk_failaction_neg partial ctx def in
- let (consts, nonconsts) = split_cases tag_lambda_list in
- let lambda1 = match fail, one_action with
- | None, Some act -> act
- | _,_ ->
- match (consts, nonconsts) with
- | ([_, act1], [_, act2]) when fail=None ->
- test_int_or_block arg act1 act2
- | (_, []) -> (* One can compare integers and pointers *)
- make_test_sequence_variant_constant fail arg consts
- | ([], _) ->
- let lam = call_switcher_variant_constr loc
- fail arg nonconsts in
- (* One must not dereference integers *)
- begin match fail with
- | None -> lam
- | Some fail -> test_int_or_block arg fail lam
- end
- | (_, _) ->
- let lam_const =
- call_switcher_variant_constant loc
- fail arg consts
- and lam_nonconst =
- call_switcher_variant_constr loc
- fail arg nonconsts in
- test_int_or_block arg lam_const lam_nonconst
+ mk_failaction_neg partial ctx def
in
- lambda1, jumps_union local_jumps total1
-
+ let consts, nonconsts = split_cases tag_lambda_list in
+ let lambda1 =
+ match (fail, one_action) with
+ | None, Some act -> act
+ | _, _ -> (
+ match (consts, nonconsts) with
+ | [ (_, act1) ], [ (_, act2) ] when fail = None ->
+ test_int_or_block arg act1 act2
+ | _, [] ->
+ (* One can compare integers and pointers *)
+ make_test_sequence_variant_constant fail arg consts
+ | [], _ -> (
+ let lam = call_switcher_variant_constr loc fail arg nonconsts in
+ (* One must not dereference integers *)
+ match fail with
+ | None -> lam
+ | Some fail -> test_int_or_block arg fail lam
+ )
+ | _, _ ->
+ let lam_const = call_switcher_variant_constant loc fail arg consts
+ and lam_nonconst =
+ call_switcher_variant_constr loc fail arg nonconsts
+ in
+ test_int_or_block arg lam_const lam_nonconst
+ )
+ in
+ (lambda1, Jumps.union local_jumps total1)
-let combine_array loc arg kind partial ctx def
- (len_lambda_list, total1, _pats) =
- let fail, local_jumps = mk_failaction_neg partial ctx def in
+let combine_array loc arg kind partial ctx def (len_lambda_list, total1, _pats)
+ =
+ let fail, local_jumps = mk_failaction_neg partial ctx def in
let lambda1 =
let newvar = Ident.create_local "len" in
let switch =
- call_switcher loc
- fail (Lvar newvar)
- 0 max_int len_lambda_list in
- bind
- Alias newvar (Lprim(Parraylength kind, [arg], loc)) switch in
- lambda1, jumps_union local_jumps total1
+ call_switcher loc fail (Lvar newvar) 0 max_int len_lambda_list
+ in
+ bind Alias newvar (Lprim (Parraylength kind, [ arg ], loc)) switch
+ in
+ (lambda1, Jumps.union local_jumps total1)
(* Insertion of debugging events *)
let rec event_branch repr lam =
- begin match lam, repr with
- (_, None) ->
- lam
- | (Levent(lam', ev), Some r) ->
+ match (lam, repr) with
+ | _, None -> lam
+ | Levent (lam', ev), Some r ->
incr r;
- Levent(lam', {lev_loc = ev.lev_loc;
- lev_kind = ev.lev_kind;
- lev_repr = repr;
- lev_env = ev.lev_env})
- | (Llet(str, k, id, lam, body), _) ->
- Llet(str, k, id, lam, event_branch repr body)
- | Lstaticraise _,_ -> lam
- | (_, Some _) ->
- Printlambda.lambda Format.str_formatter lam ;
- fatal_error
- ("Matching.event_branch: "^Format.flush_str_formatter ())
- end
-
+ Levent
+ ( lam',
+ { lev_loc = ev.lev_loc;
+ lev_kind = ev.lev_kind;
+ lev_repr = repr;
+ lev_env = ev.lev_env
+ } )
+ | Llet (str, k, id, lam, body), _ ->
+ Llet (str, k, id, lam, event_branch repr body)
+ | Lstaticraise _, _ -> lam
+ | _, Some _ ->
+ Printlambda.lambda Format.str_formatter lam;
+ fatal_error ("Matching.event_branch: " ^ Format.flush_str_formatter ())
(*
This exception is raised when the compiler cannot produce code
exception Unused
let compile_list compile_fun division =
-
let rec c_rec totals = function
- | [] -> [], jumps_unions totals, []
- | (key, cell) :: rem ->
- begin match cell.ctx with
- | [] -> c_rec totals rem
- | _ ->
+ | [] -> ([], Jumps.unions totals, [])
+ | (key, cell) :: rem -> (
+ if Context.is_empty cell.ctx then
+ c_rec totals rem
+ else
try
- let (lambda1, total1) = compile_fun cell.ctx cell.pm in
- let c_rem, total, new_pats =
- c_rec
- (jumps_map ctx_combine total1::totals) rem in
- ((key,lambda1)::c_rem), total, (cell.pat::new_pats)
- with
- | Unused -> c_rec totals rem
- end in
+ let lambda1, total1 = compile_fun cell.ctx cell.pm in
+ let c_rem, total, new_discrs =
+ c_rec (Jumps.map Context.combine total1 :: totals) rem
+ in
+ ((key, lambda1) :: c_rem, total, cell.discr :: new_discrs)
+ with Unused -> c_rec totals rem
+ )
+ in
c_rec [] division
-
let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
let rec do_rec r total_r = function
- | [] -> r,total_r
- | (mat,i,vars,pm)::rem ->
- begin try
- let ctx = select_columns mat ctx in
- let handler_i, total_i =
- compile_fun ctx pm in
+ | [] -> (r, total_r)
+ | { provenance = mat; exit = i; vars; pm } :: rem -> (
+ try
+ let ctx = Context.select_columns mat ctx in
+ let handler_i, total_i = compile_fun ctx pm in
match raw_action r with
- | Lstaticraise (j,args) ->
- if i=j then
- List.fold_right2 (bind_with_value_kind Alias)
- vars args handler_i,
- jumps_map (ctx_rshift_num (ncols mat)) total_i
+ | Lstaticraise (j, args) ->
+ if i = j then
+ ( List.fold_right2
+ (bind_with_value_kind Alias)
+ vars args handler_i,
+ Jumps.map (Context.rshift_num (ncols mat)) total_i )
else
do_rec r total_r rem
| _ ->
do_rec
- (Lstaticcatch (r,(i,vars), handler_i))
- (jumps_union
- (jumps_remove i total_r)
- (jumps_map (ctx_rshift_num (ncols mat)) total_i))
- rem
- with
- | Unused ->
- do_rec (Lstaticcatch (r, (i,vars), lambda_unit)) total_r rem
- end in
+ (Lstaticcatch (r, (i, vars), handler_i))
+ (Jumps.union (Jumps.remove i total_r)
+ (Jumps.map (Context.rshift_num (ncols mat)) total_i))
+ rem
+ with Unused ->
+ do_rec (Lstaticcatch (r, (i, vars), lambda_unit)) total_r rem
+ )
+ in
do_rec lambda1 total1 to_catch
-
let compile_test compile_fun partial divide combine ctx to_match =
let division = divide ctx to_match in
- let c_div = compile_list compile_fun division in
+ let c_div = compile_list compile_fun division.cells in
match c_div with
- | [],_,_ ->
- begin match mk_failaction_neg partial ctx to_match.default with
- | None,_ -> raise Unused
- | Some l,total -> l,total
- end
- | _ ->
- combine ctx to_match.default c_div
+ | [], _, _ -> (
+ match mk_failaction_neg partial ctx to_match.default with
+ | None, _ -> raise Unused
+ | Some l, total -> (l, total)
+ )
+ | _ -> combine ctx to_match.default c_div
(* Attempt to avoid some useless bindings by lowering them *)
(* Approximation of v present in lam *)
let rec approx_present v = function
| Lconst _ -> false
- | Lstaticraise (_,args) ->
+ | Lstaticraise (_, args) ->
List.exists (fun lam -> approx_present v lam) args
- | Lprim (_,args,_) ->
- List.exists (fun lam -> approx_present v lam) args
- | Llet (Alias, _k, _, l1, l2) ->
- approx_present v l1 || approx_present v l2
+ | Lprim (_, args, _) -> List.exists (fun lam -> approx_present v lam) args
+ | Llet (Alias, _k, _, l1, l2) -> approx_present v l1 || approx_present v l2
| Lvar vv -> Ident.same v vv
| _ -> true
-let rec lower_bind v arg lam = match lam with
-| Lifthenelse (cond, ifso, ifnot) ->
- let pcond = approx_present v cond
- and pso = approx_present v ifso
- and pnot = approx_present v ifnot in
- begin match pcond, pso, pnot with
- | false, false, false -> lam
- | false, true, false ->
- Lifthenelse (cond, lower_bind v arg ifso, ifnot)
- | false, false, true ->
- Lifthenelse (cond, ifso, lower_bind v arg ifnot)
- | _,_,_ -> bind Alias v arg lam
- end
-| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as sw), loc)
+let rec lower_bind v arg lam =
+ match lam with
+ | Lifthenelse (cond, ifso, ifnot) -> (
+ let pcond = approx_present v cond
+ and pso = approx_present v ifso
+ and pnot = approx_present v ifnot in
+ match (pcond, pso, pnot) with
+ | false, false, false -> lam
+ | false, true, false -> Lifthenelse (cond, lower_bind v arg ifso, ifnot)
+ | false, false, true -> Lifthenelse (cond, ifso, lower_bind v arg ifnot)
+ | _, _, _ -> bind Alias v arg lam
+ )
+ | Lswitch (ls, ({ sw_consts = [ (i, act) ]; sw_blocks = [] } as sw), loc)
when not (approx_present v ls) ->
- Lswitch (ls, {sw with sw_consts = [i,lower_bind v arg act]}, loc)
-| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as sw), loc)
+ Lswitch (ls, { sw with sw_consts = [ (i, lower_bind v arg act) ] }, loc)
+ | Lswitch (ls, ({ sw_consts = []; sw_blocks = [ (i, act) ] } as sw), loc)
when not (approx_present v ls) ->
- Lswitch (ls, {sw with sw_blocks = [i,lower_bind v arg act]}, loc)
-| Llet (Alias, k, vv, lv, l) ->
- if approx_present v lv then
- bind Alias v arg lam
- else
- Llet (Alias, k, vv, lv, lower_bind v arg l)
-| _ ->
- bind Alias v arg lam
-
-let bind_check str v arg lam = match str,arg with
-| _, Lvar _ ->bind str v arg lam
-| Alias,_ -> lower_bind v arg lam
-| _,_ -> bind str v arg lam
-
-let comp_exit ctx m = match m.default with
-| (_,i)::_ -> Lstaticraise (i,[]), jumps_singleton i ctx
-| _ -> fatal_error "Matching.comp_exit"
+ Lswitch (ls, { sw with sw_blocks = [ (i, lower_bind v arg act) ] }, loc)
+ | Llet (Alias, k, vv, lv, l) ->
+ if approx_present v lv then
+ bind Alias v arg lam
+ else
+ Llet (Alias, k, vv, lv, lower_bind v arg l)
+ | _ -> bind Alias v arg lam
+let bind_check str v arg lam =
+ match (str, arg) with
+ | _, Lvar _ -> bind str v arg lam
+ | Alias, _ -> lower_bind v arg lam
+ | _, _ -> bind str v arg lam
+let comp_exit ctx m =
+ match Default_environment.pop m.default with
+ | Some ((_, i), _) -> (Lstaticraise (i, []), Jumps.singleton i ctx)
+ | None -> fatal_error "Matching.comp_exit"
-let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs =
+let rec comp_match_handlers comp_fun partial ctx first_match next_matchs =
match next_matchs with
- | [] -> comp_fun partial ctx arg first_match
- | rem ->
+ | [] -> comp_fun partial ctx first_match
+ | rem -> (
let rec c_rec body total_body = function
- | [] -> body, total_body
+ | [] -> (body, total_body)
(* Hum, -1 means never taken
| (-1,pm)::rem -> c_rec body total_body rem *)
- | (i,pm)::rem ->
- let ctx_i,total_rem = jumps_extract i total_body in
- begin match ctx_i with
- | [] -> c_rec body total_body rem
- | _ ->
- try
- let li,total_i =
- comp_fun
- (match rem with [] -> partial | _ -> Partial)
- ctx_i arg pm in
- c_rec
- (Lstaticcatch (body,(i,[]),li))
- (jumps_union total_i total_rem)
- rem
- with
- | Unused ->
- c_rec (Lstaticcatch (body,(i,[]),lambda_unit))
- total_rem rem
- end in
- try
- let first_lam,total = comp_fun Partial ctx arg first_match in
- c_rec first_lam total rem
- with Unused -> match next_matchs with
- | [] -> raise Unused
- | (_,x)::xs -> comp_match_handlers comp_fun partial ctx arg x xs
+ | (i, pm) :: rem -> (
+ let ctx_i, total_rem = Jumps.extract i total_body in
+ if Context.is_empty ctx_i then
+ c_rec body total_body rem
+ else
+ try
+ let li, total_i =
+ comp_fun
+ ( match rem with
+ | [] -> partial
+ | _ -> Partial
+ )
+ ctx_i pm
+ in
+ c_rec
+ (Lstaticcatch (body, (i, []), li))
+ (Jumps.union total_i total_rem)
+ rem
+ with Unused ->
+ c_rec (Lstaticcatch (body, (i, []), lambda_unit)) total_rem rem
+ )
+ in
+ try
+ let first_lam, total = comp_fun Partial ctx first_match in
+ c_rec first_lam total rem
+ with Unused -> (
+ match next_matchs with
+ | [] -> raise Unused
+ | (_, x) :: xs -> comp_match_handlers comp_fun partial ctx x xs
+ )
+ )
(* To find reasonable names for variables *)
let rec name_pattern default = function
- (pat :: _, _) :: rem ->
- begin match pat.pat_desc with
- Tpat_var (id, _) -> id
- | Tpat_alias(_, id, _) -> id
+ | (pat :: _, _) :: rem -> (
+ match pat.pat_desc with
+ | Tpat_var (id, _) -> id
+ | Tpat_alias (_, id, _) -> id
| _ -> name_pattern default rem
- end
+ )
| _ -> Ident.create_local default
-let arg_to_var arg cls = match arg with
-| Lvar v -> v,arg
-| _ ->
- let v = name_pattern "*match*" cls in
- v,Lvar v
-
+let arg_to_var arg cls =
+ match arg with
+ | Lvar v -> (v, arg)
+ | _ ->
+ let v = name_pattern "*match*" cls in
+ (v, Lvar v)
(*
The main compilation function.
Output: a lambda term, a jump summary {..., exit number -> context, .. }
*)
-let rec compile_match repr partial ctx m = match m with
-| { cases = []; args = [] } -> comp_exit ctx m
-| { cases = ([], action) :: rem } ->
- if is_guarded action then begin
- let (lambda, total) =
- compile_match None partial ctx { m with cases = rem } in
- event_branch repr (patch_guarded lambda action), total
- end else
- (event_branch repr action, jumps_empty)
-| { args = (arg, str)::argl } ->
- let v,newarg = arg_to_var arg m.cases in
- let first_match,rem =
- split_precompile (Some v)
- { m with args = (newarg, Alias) :: argl } in
- let (lam, total) =
- comp_match_handlers
- ((if dbg then do_compile_matching_pr else do_compile_matching) repr)
- partial ctx newarg first_match rem in
- bind_check str v arg lam, total
-| _ -> assert false
-
+let rec compile_match repr partial ctx (m : pattern_matching) =
+ match m with
+ | { cases = []; args = [] } -> comp_exit ctx m
+ | { cases = ([], action) :: rem } ->
+ if is_guarded action then
+ let lambda, total =
+ compile_match None partial ctx { m with cases = rem }
+ in
+ (event_branch repr (patch_guarded lambda action), total)
+ else
+ (event_branch repr action, Jumps.empty)
+ | { args = (arg, str) :: argl } ->
+ let v, newarg = arg_to_var arg m.cases in
+ let first_match, rem =
+ split_and_precompile (Some v) { m with args = (newarg, Alias) :: argl }
+ in
+ let lam, total =
+ comp_match_handlers
+ (( if dbg then
+ do_compile_matching_pr
+ else
+ do_compile_matching
+ )
+ repr)
+ partial ctx first_match rem
+ in
+ (bind_check str v arg lam, total)
+ | _ -> assert false
(* verbose version of do_compile_matching, for debug *)
-
-and do_compile_matching_pr repr partial ctx arg x =
+and do_compile_matching_pr repr partial ctx x =
Format.eprintf "COMPILE: %s\nMATCH\n"
- (match partial with Partial -> "Partial" | Total -> "Total") ;
- pretty_precompiled x ;
- Format.eprintf "CTX\n" ;
- pretty_ctx ctx ;
- let (_, jumps) as r = do_compile_matching repr partial ctx arg x in
- Format.eprintf "JUMPS\n" ;
- pretty_jumps jumps ;
+ ( match partial with
+ | Partial -> "Partial"
+ | Total -> "Total"
+ );
+ pretty_precompiled x;
+ Format.eprintf "CTX\n";
+ Context.eprintf ctx;
+ let ((_, jumps) as r) = do_compile_matching repr partial ctx x in
+ Format.eprintf "JUMPS\n";
+ Jumps.eprintf jumps;
r
-and do_compile_matching repr partial ctx arg pmh = match pmh with
-| Pm pm ->
- let pat = what_is_cases pm.cases in
- begin match pat.pat_desc with
- | Tpat_any ->
- compile_no_test
- divide_var ctx_rshift repr partial ctx pm
- | Tpat_tuple patl ->
- compile_no_test
- (divide_tuple (List.length patl) (normalize_pat pat)) ctx_combine
- repr partial ctx pm
- | Tpat_record ((_, lbl,_)::_,_) ->
- compile_no_test
- (divide_record lbl.lbl_all (normalize_pat pat))
- ctx_combine repr partial ctx pm
- | Tpat_constant cst ->
- compile_test
- (compile_match repr partial) partial
- divide_constant
- (combine_constant pat.pat_loc arg cst partial)
- ctx pm
- | Tpat_construct (_, cstr, _) ->
- compile_test
- (compile_match repr partial) partial
- divide_constructor
- (combine_constructor pat.pat_loc arg pat cstr partial)
- ctx pm
- | Tpat_array _ ->
- let kind = Typeopt.array_pattern_kind pat in
- compile_test (compile_match repr partial) partial
- (divide_array kind) (combine_array pat.pat_loc arg kind partial)
- ctx pm
- | Tpat_lazy _ ->
- compile_no_test
- (divide_lazy (normalize_pat pat))
- ctx_combine repr partial ctx pm
- | Tpat_variant(_, _, row) ->
- compile_test (compile_match repr partial) partial
- (divide_variant !row)
- (combine_variant pat.pat_loc !row arg partial)
- ctx pm
- | _ -> assert false
- end
-| PmVar {inside=pmh ; var_arg=arg} ->
- let lam, total =
- do_compile_matching repr partial (ctx_lshift ctx) arg pmh in
- lam, jumps_map ctx_rshift total
-| PmOr {body=body ; handlers=handlers} ->
- let lam, total = compile_match repr partial ctx body in
- compile_orhandlers (compile_match repr partial) lam total ctx handlers
+and do_compile_matching repr partial ctx pmh =
+ match pmh with
+ | Pm pm -> (
+ let arg =
+ match pm.args with
+ | (first_arg, _) :: _ -> first_arg
+ | _ ->
+ (* We arrive in do_compile_matching from:
+ - compile_matching
+ - recursive call on PmVars
+ The first one explicitly checks that [args] is nonempty, the
+ second one is only generated when the inner pm first looks at
+ a variable (i.e. there is something to look at).
+ *)
+ assert false
+ in
+ let pat = what_is_cases pm.cases in
+ match pat.pat_desc with
+ | Tpat_any ->
+ compile_no_test divide_var Context.rshift repr partial ctx pm
+ | Tpat_tuple patl ->
+ compile_no_test
+ (divide_tuple (List.length patl) (normalize_pat pat))
+ Context.combine repr partial ctx pm
+ | Tpat_record ((_, lbl, _) :: _, _) ->
+ compile_no_test
+ (divide_record lbl.lbl_all (normalize_pat pat))
+ Context.combine repr partial ctx pm
+ | Tpat_constant cst ->
+ compile_test
+ (compile_match repr partial)
+ partial divide_constant
+ (combine_constant pat.pat_loc arg cst partial)
+ ctx pm
+ | Tpat_construct (_, cstr, _) ->
+ compile_test
+ (compile_match repr partial)
+ partial divide_constructor
+ (combine_constructor pat.pat_loc arg pat cstr partial)
+ ctx pm
+ | Tpat_array _ ->
+ let kind = Typeopt.array_pattern_kind pat in
+ compile_test
+ (compile_match repr partial)
+ partial (divide_array kind)
+ (combine_array pat.pat_loc arg kind partial)
+ ctx pm
+ | Tpat_lazy _ ->
+ compile_no_test
+ (divide_lazy (normalize_pat pat))
+ Context.combine repr partial ctx pm
+ | Tpat_variant (_, _, row) ->
+ compile_test
+ (compile_match repr partial)
+ partial (divide_variant !row)
+ (combine_variant pat.pat_loc !row arg partial)
+ ctx pm
+ | _ -> assert false
+ )
+ | PmVar { inside = pmh } ->
+ let lam, total =
+ do_compile_matching repr partial (Context.lshift ctx) pmh
+ in
+ (lam, Jumps.map Context.rshift total)
+ | PmOr { body; handlers } ->
+ let lam, total = compile_match repr partial ctx body in
+ compile_orhandlers (compile_match repr partial) lam total ctx handlers
and compile_no_test divide up_ctx repr partial ctx to_match =
- let {pm=this_match ; ctx=this_ctx } = divide ctx to_match in
- let lambda,total = compile_match repr partial this_ctx this_match in
- lambda, jumps_map up_ctx total
-
-
-
+ let { pm = this_match; ctx = this_ctx } = divide ctx to_match in
+ let lambda, total = compile_match repr partial this_ctx this_match in
+ (lambda, Jumps.map up_ctx total)
(* The entry points *)
I have generalized the patch, so as to also find mutable fields.
*)
-let find_in_pat pred =
- let rec find_rec p =
- pred p.pat_desc ||
- begin match p.pat_desc with
- | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) | Tpat_lazy p ->
- find_rec p
- | Tpat_tuple ps|Tpat_construct (_,_,ps) | Tpat_array ps ->
- List.exists find_rec ps
- | Tpat_record (lpats,_) ->
- List.exists
- (fun (_, _, p) -> find_rec p)
- lpats
- | Tpat_or (p,q,_) ->
- find_rec p || find_rec q
- | Tpat_constant _ | Tpat_var _
- | Tpat_any | Tpat_variant (_,None,_) -> false
- | Tpat_exception _ -> assert false
- end in
- find_rec
-
-let is_lazy_pat = function
+let is_lazy_pat p = match p.pat_desc with
| Tpat_lazy _ -> true
- | Tpat_alias _ | Tpat_variant _ | Tpat_record _
- | Tpat_tuple _|Tpat_construct _ | Tpat_array _
- | Tpat_or _ | Tpat_constant _ | Tpat_var _ | Tpat_any
- -> false
+ | Tpat_alias _
+ | Tpat_variant _
+ | Tpat_record _
+ | Tpat_tuple _
+ | Tpat_construct _
+ | Tpat_array _
+ | Tpat_or _
+ | Tpat_constant _
+ | Tpat_var _
+ | Tpat_any ->
+ false
| Tpat_exception _ -> assert false
-let is_lazy p = find_in_pat is_lazy_pat p
+let has_lazy p =
+ Typedtree.exists_pattern is_lazy_pat p
-let have_mutable_field p = match p with
-| Tpat_record (lps,_) ->
- List.exists
- (fun (_,lbl,_) ->
- match lbl.Types.lbl_mut with
- | Mutable -> true
- | Immutable -> false)
- lps
-| Tpat_alias _ | Tpat_variant _ | Tpat_lazy _
-| Tpat_tuple _|Tpat_construct _ | Tpat_array _
-| Tpat_or _
-| Tpat_constant _ | Tpat_var _ | Tpat_any
- -> false
-| Tpat_exception _ -> assert false
-
-let is_mutable p = find_in_pat have_mutable_field p
+let is_record_with_mutable_field p =
+ match p.pat_desc with
+ | Tpat_record (lps, _) ->
+ List.exists
+ (fun (_, lbl, _) ->
+ match lbl.Types.lbl_mut with
+ | Mutable -> true
+ | Immutable -> false)
+ lps
+ | Tpat_alias _
+ | Tpat_variant _
+ | Tpat_lazy _
+ | Tpat_tuple _
+ | Tpat_construct _
+ | Tpat_array _
+ | Tpat_or _
+ | Tpat_constant _
+ | Tpat_var _
+ | Tpat_any ->
+ false
+ | Tpat_exception _ -> assert false
+
+let has_mutable p =
+ Typedtree.exists_pattern is_record_with_mutable_field p
(* Downgrade Total when
1. Matching accesses some mutable fields;
2. And there are guards or lazy patterns.
*)
-let check_partial is_mutable is_lazy pat_act_list = function
+let check_partial has_mutable has_lazy pat_act_list = function
| Partial -> Partial
| Total ->
if
- pat_act_list = [] || (* allow empty case list *)
- List.exists
- (fun (pats, lam) ->
- is_mutable pats && (is_guarded lam || is_lazy pats))
- pat_act_list
- then Partial
- else Total
+ pat_act_list = []
+ || (* allow empty case list *)
+ List.exists
+ (fun (pats, lam) ->
+ has_mutable pats && (is_guarded lam || has_lazy pats))
+ pat_act_list
+ then
+ Partial
+ else
+ Total
let check_partial_list =
- check_partial (List.exists is_mutable) (List.exists is_lazy)
-let check_partial = check_partial is_mutable is_lazy
+ check_partial (List.exists has_mutable) (List.exists has_lazy)
-(* have toplevel handler when appropriate *)
+let check_partial = check_partial has_mutable has_lazy
-let start_ctx n = [{left=[] ; right = omegas n}]
+(* have toplevel handler when appropriate *)
let check_total total lambda i handler_fun =
- if jumps_is_empty total then
+ if Jumps.is_empty total then
lambda
- else begin
- Lstaticcatch(lambda, (i,[]), handler_fun())
- end
+ else
+ Lstaticcatch (lambda, (i, []), handler_fun ())
let compile_matching repr handler_fun arg pat_act_list partial =
let partial = check_partial pat_act_list partial in
match partial with
- | Partial ->
+ | Partial -> (
let raise_num = next_raise_count () in
let pm =
- { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
- args = [arg, Strict] ;
- default = [[[omega]],raise_num]} in
- begin try
- let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
+ { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
+ args = [ (arg, Strict) ];
+ default = Default_environment.(cons [ [ omega ] ] raise_num empty)
+ }
+ in
+ try
+ let lambda, total = compile_match repr partial (Context.start 1) pm in
check_total total lambda raise_num handler_fun
- with
- | Unused -> assert false (* ; handler_fun() *)
- end
+ with Unused -> assert false
+ (* ; handler_fun() *)
+ )
| Total ->
let pm =
- { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
- args = [arg, Strict] ;
- default = []} in
- let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
- assert (jumps_is_empty total) ;
+ { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
+ args = [ (arg, Strict) ];
+ default = Default_environment.empty
+ }
+ in
+ let lambda, total = compile_match repr partial (Context.start 1) pm in
+ assert (Jumps.is_empty total);
lambda
-
let partial_function loc () =
let slot =
- transl_extension_path loc
- Env.initial_safe_string Predef.path_match_failure
+ transl_extension_path loc Env.initial_safe_string Predef.path_match_failure
in
- let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
- Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Immutable, None),
- [slot; Lconst(Const_block(0,
- [Const_base(Const_string (fname, None));
- Const_base(Const_int line);
- Const_base(Const_int char)]))], loc)], loc)
+ let fname, line, char = Location.get_pos_info loc.Location.loc_start in
+ Lprim
+ ( Praise Raise_regular,
+ [ Lprim
+ ( Pmakeblock (0, Immutable, None),
+ [ slot;
+ Lconst
+ (Const_block
+ ( 0,
+ [ Const_base (Const_string (fname, None));
+ Const_base (Const_int line);
+ Const_base (Const_int char)
+ ] ))
+ ],
+ loc )
+ ],
+ loc )
let for_function loc repr param pat_act_list partial =
compile_matching repr (partial_function loc) param pat_act_list partial
(* In the following two cases, exhaustiveness info is not available! *)
let for_trywith param pat_act_list =
compile_matching None
- (fun () -> Lprim(Praise Raise_reraise, [param], Location.none))
+ (fun () -> Lprim (Praise Raise_reraise, [ param ], Location.none))
param pat_act_list Partial
let simple_for_let loc param pat body =
- compile_matching None (partial_function loc) param [pat, body] Partial
-
+ compile_matching None (partial_function loc) param [ (pat, body) ] Partial
(* Optimize binding of immediate tuples
| Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2)
| Lstaticcatch (l1, b, l2) ->
Lstaticcatch (map_return f l1, b, map_return f l2)
- | Lstaticraise _ | Lprim(Praise _, _, _) as l -> l
+ | (Lstaticraise _ | Lprim (Praise _, _, _)) as l -> l
| l -> f l
(* The 'opt' reference indicates if the optimization is worthy.
*)
let assign_pat opt nraise catch_ids loc pat lam =
- let rec collect acc pat lam = match pat.pat_desc, lam with
- | Tpat_tuple patl, Lprim(Pmakeblock _, lams, _) ->
- opt := true;
- List.fold_left2 collect acc patl lams
- | Tpat_tuple patl, Lconst(Const_block(_, scl)) ->
- opt := true;
- let collect_const acc pat sc = collect acc pat (Lconst sc) in
- List.fold_left2 collect_const acc patl scl
- | _ ->
- (* pattern idents will be bound in staticcatch (let body), so we
+ let rec collect acc pat lam =
+ match (pat.pat_desc, lam) with
+ | Tpat_tuple patl, Lprim (Pmakeblock _, lams, _) ->
+ opt := true;
+ List.fold_left2 collect acc patl lams
+ | Tpat_tuple patl, Lconst (Const_block (_, scl)) ->
+ opt := true;
+ let collect_const acc pat sc = collect acc pat (Lconst sc) in
+ List.fold_left2 collect_const acc patl scl
+ | _ ->
+ (* pattern idents will be bound in staticcatch (let body), so we
refresh them here to guarantee binders uniqueness *)
- let pat_ids = pat_bound_idents pat in
- let fresh_ids = List.map (fun id -> id, Ident.rename id) pat_ids in
- (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc
+ let pat_ids = pat_bound_idents pat in
+ let fresh_ids = List.map (fun id -> (id, Ident.rename id)) pat_ids in
+ (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc
in
-
(* sublets were accumulated by 'collect' with the leftmost tuple
pattern at the bottom of the list; to respect right-to-left
evaluation order for tuples, we must evaluate sublets
let add_ids acc (ids, _pat, _lam) = List.fold_left add acc ids in
let tbl = List.fold_left add_ids Ident.empty rev_sublets in
let fresh_var id = Lvar (Ident.find_same id tbl) in
- Lstaticraise(nraise, List.map fresh_var catch_ids)
+ Lstaticraise (nraise, List.map fresh_var catch_ids)
in
let push_sublet code (_ids, pat, lam) = simple_for_let loc lam pat code in
List.fold_left push_sublet exit rev_sublets
| Tpat_any ->
(* This eliminates a useless variable (and stack slot in bytecode)
for "let _ = ...". See #6865. *)
- Lsequence(param, body)
+ Lsequence (param, body)
| Tpat_var (id, _) ->
(* fast path, and keep track of simple bindings to unboxable numbers *)
let k = Typeopt.value_kind pat.pat_env pat.pat_type in
- Llet(Strict, k, id, param, body)
+ Llet (Strict, k, id, param, body)
| _ ->
let opt = ref false in
let nraise = next_raise_count () in
let catch_ids = pat_bound_idents_full pat in
let ids_with_kinds =
- List.map (fun (id, _, typ) -> id, Typeopt.value_kind pat.pat_env typ)
+ List.map
+ (fun (id, _, typ) -> (id, Typeopt.value_kind pat.pat_env typ))
catch_ids
in
let ids = List.map (fun (id, _, _) -> id) catch_ids in
let bind = map_return (assign_pat opt nraise ids loc pat) param in
- if !opt then Lstaticcatch(bind, (nraise, ids_with_kinds), body)
- else simple_for_let loc param pat body
+ if !opt then
+ Lstaticcatch (bind, (nraise, ids_with_kinds), body)
+ else
+ simple_for_let loc param pat body
(* Handling of tupled functions and matchings *)
let for_tupled_function loc paraml pats_act_list partial =
let partial = check_partial_list pats_act_list partial in
let raise_num = next_raise_count () in
- let omegas = [List.map (fun _ -> omega) paraml] in
+ let omegas = [ List.map (fun _ -> omega) paraml ] in
let pm =
{ cases = pats_act_list;
- args = List.map (fun id -> (Lvar id, Strict)) paraml ;
- default = [omegas,raise_num]
- } in
+ args = List.map (fun id -> (Lvar id, Strict)) paraml;
+ default = Default_environment.(cons omegas raise_num empty)
+ }
+ in
try
- let (lambda, total) = compile_match None partial
- (start_ctx (List.length paraml)) pm in
+ let lambda, total =
+ compile_match None partial (Context.start (List.length paraml)) pm
+ in
check_total total lambda raise_num (partial_function loc)
- with
- | Unused -> partial_function loc ()
-
-
+ with Unused -> partial_function loc ()
-let flatten_pattern size p = match p.pat_desc with
-| Tpat_tuple args -> args
-| Tpat_any -> omegas size
-| _ -> raise Cannot_flatten
-
-let rec flatten_pat_line size p k = match p.pat_desc with
-| Tpat_any -> omegas size::k
-| Tpat_tuple args -> args::k
-| Tpat_or (p1,p2,_) -> flatten_pat_line size p1 (flatten_pat_line size p2 k)
-| Tpat_alias (p,_,_) -> (* Note: if this 'as' pat is here, then this is a
- useless binding, solves PR#3780 *)
- flatten_pat_line size p k
-| _ -> fatal_error "Matching.flatten_pat_line"
+let flatten_pattern size p =
+ match p.pat_desc with
+ | Tpat_tuple args -> args
+ | Tpat_any -> omegas size
+ | _ -> raise Cannot_flatten
let flatten_cases size cases =
List.map
- (fun (ps,action) -> match ps with
- | [p] -> flatten_pattern size p,action
- | _ -> fatal_error "Matching.flatten_case")
+ (fun (ps, action) ->
+ match ps with
+ | [ p ] -> (flatten_pattern size p, action)
+ | _ -> fatal_error "Matching.flatten_case")
cases
-let flatten_matrix size pss =
- List.fold_right
- (fun ps r -> match ps with
- | [p] -> flatten_pat_line size p r
- | _ -> fatal_error "Matching.flatten_matrix")
- pss []
-
-let flatten_def size def =
- List.map
- (fun (pss,i) -> flatten_matrix size pss,i)
- def
-
let flatten_pm size args pm =
- {args = args ; cases = flatten_cases size pm.cases ;
- default = flatten_def size pm.default}
-
-
-let flatten_precompiled size args pmh = match pmh with
-| Pm pm -> Pm (flatten_pm size args pm)
-| PmOr {body=b ; handlers=hs ; or_matrix=m} ->
- PmOr
- {body=flatten_pm size args b ;
- handlers=
- List.map
- (fun (mat,i,vars,pm) -> flatten_matrix size mat,i,vars,pm)
- hs ;
- or_matrix=flatten_matrix size m ;}
-| PmVar _ -> assert false
+ { args;
+ cases = flatten_cases size pm.cases;
+ default = Default_environment.flatten size pm.default
+ }
+
+let flatten_handler size handler =
+ { handler with provenance = flatten_matrix size handler.provenance }
+
+let flatten_precompiled size args pmh =
+ match pmh with
+ | Pm pm -> Pm (flatten_pm size args pm)
+ | PmOr { body = b; handlers = hs; or_matrix = m } ->
+ PmOr
+ { body = flatten_pm size args b;
+ handlers = List.map (flatten_handler size) hs;
+ or_matrix = flatten_matrix size m
+ }
+ | PmVar _ -> assert false
(*
compiled_flattened is a ``comp_fun'' argument to comp_match_handlers.
Hence it needs a fourth argument, which it ignores
*)
-let compile_flattened repr partial ctx _ pmh = match pmh with
-| Pm pm -> compile_match repr partial ctx pm
-| PmOr {body=b ; handlers=hs} ->
- let lam, total = compile_match repr partial ctx b in
- compile_orhandlers (compile_match repr partial) lam total ctx hs
-| PmVar _ -> assert false
+let compile_flattened repr partial ctx pmh =
+ match pmh with
+ | Pm pm -> compile_match repr partial ctx pm
+ | PmOr { body = b; handlers = hs } ->
+ let lam, total = compile_match repr partial ctx b in
+ compile_orhandlers (compile_match repr partial) lam total ctx hs
+ | PmVar _ -> assert false
let do_for_multiple_match loc paraml pat_act_list partial =
let repr = None in
let partial = check_partial pat_act_list partial in
- let raise_num,pm1 =
- match partial with
- | Partial ->
- let raise_num = next_raise_count () in
- raise_num,
- { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
- args = [Lprim(Pmakeblock(0, Immutable, None), paraml, loc), Strict];
- default = [[[omega]],raise_num] }
- | _ ->
- -1,
- { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
- args = [Lprim(Pmakeblock(0, Immutable, None), paraml, loc), Strict];
- default = [] } in
-
+ let raise_num, pm1 =
+ let raise_num, default =
+ match partial with
+ | Partial ->
+ let raise_num = next_raise_count () in
+ (raise_num, Default_environment.(cons [ [ omega ] ] raise_num empty))
+ | Total -> (-1, Default_environment.empty)
+ in
+ ( raise_num,
+ { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
+ args =
+ [ (Lprim (Pmakeblock (0, Immutable, None), paraml, loc), Strict) ];
+ default
+ } )
+ in
try
try
-(* Once for checking that compilation is possible *)
- let next, nexts = split_precompile None pm1 in
-
+ (* Once for checking that compilation is possible *)
+ let next, nexts = split_and_precompile None pm1 in
let size = List.length paraml
and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
- let args = List.map (fun id -> Lvar id, Alias) idl in
-
+ let args = List.map (fun id -> (Lvar id, Alias)) idl in
let flat_next = flatten_precompiled size args next
and flat_nexts =
- List.map
- (fun (e,pm) -> e,flatten_precompiled size args pm)
- nexts in
-
+ List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
+ in
let lam, total =
- comp_match_handlers
- (compile_flattened repr)
- partial (start_ctx size) () flat_next flat_nexts in
+ comp_match_handlers (compile_flattened repr) partial
+ (Context.start size) flat_next flat_nexts
+ in
List.fold_right2 (bind Strict) idl paraml
- (match partial with
- | Partial ->
- check_total total lam raise_num (partial_function loc)
+ ( match partial with
+ | Partial -> check_total total lam raise_num (partial_function loc)
| Total ->
- assert (jumps_is_empty total) ;
- lam)
- with Cannot_flatten ->
- let (lambda, total) = compile_match None partial (start_ctx 1) pm1 in
- begin match partial with
- | Partial ->
- check_total total lambda raise_num (partial_function loc)
+ assert (Jumps.is_empty total);
+ lam
+ )
+ with Cannot_flatten -> (
+ let lambda, total = compile_match None partial (Context.start 1) pm1 in
+ match partial with
+ | Partial -> check_total total lambda raise_num (partial_function loc)
| Total ->
- assert (jumps_is_empty total) ;
+ assert (Jumps.is_empty total);
lambda
- end
- with Unused ->
- assert false (* ; partial_function loc () *)
+ )
+ with Unused -> assert false
+
+(* ; partial_function loc () *)
(* PR#4828: Believe it or not, the 'paraml' argument below
may not be side effect free. *)
-let param_to_var param = match param with
-| Lvar v -> v,None
-| _ -> Ident.create_local "*match*",Some param
+let param_to_var param =
+ match param with
+ | Lvar v -> (v, None)
+ | _ -> (Ident.create_local "*match*", Some param)
-let bind_opt (v,eo) k = match eo with
-| None -> k
-| Some e -> Lambda.bind Strict v e k
+let bind_opt (v, eo) k =
+ match eo with
+ | None -> k
+ | Some e -> Lambda.bind Strict v e k
let for_multiple_match loc paraml pat_act_list partial =
let v_paraml = List.map param_to_var paraml in
- let paraml = List.map (fun (v,_) -> Lvar v) v_paraml in
+ let paraml = List.map (fun (v, _) -> Lvar v) v_paraml in
List.fold_right bind_opt v_paraml
(do_for_multiple_match loc paraml pat_act_list partial)
sw_blocks =
List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
sw_failaction =
- Misc.may_map (eliminate_ref id) sw.sw_failaction; },
+ Option.map (eliminate_ref id) sw.sw_failaction; },
loc)
| Lstringswitch(e, sw, default, loc) ->
Lstringswitch
(eliminate_ref id e,
List.map (fun (s, e) -> (s, eliminate_ref id e)) sw,
- Misc.may_map (eliminate_ref id) default, loc)
+ Option.map (eliminate_ref id) default, loc)
| Lstaticraise (i,args) ->
Lstaticraise (i,List.map (eliminate_ref id) args)
| Lstaticcatch(e1, i, e2) ->
let new_l = simplif l
and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
and new_blocks = List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
- and new_fail = Misc.may_map simplif sw.sw_failaction in
+ and new_fail = Option.map simplif sw.sw_failaction in
Lswitch
(new_l,
{sw with sw_consts = new_consts ; sw_blocks = new_blocks;
| Lstringswitch(l,sw,d,loc) ->
Lstringswitch
(simplif l,List.map (fun (s,l) -> s,simplif l) sw,
- Misc.may_map simplif d,loc)
+ Option.map simplif d,loc)
| Lstaticraise (i,[]) as l ->
begin try
let _,handler = Hashtbl.find subst i in
Assumes |args| = |params|.
*)
+let exact_application {kind; params; _} args =
+ match kind with
+ | Curried ->
+ if List.length params <> List.length args
+ then None
+ else Some args
+ | Tupled ->
+ begin match args with
+ | [Lprim(Pmakeblock _, tupled_args, _)] ->
+ if List.length params <> List.length tupled_args
+ then None
+ else Some tupled_args
+ | [Lconst(Const_block (_, const_args))] ->
+ if List.length params <> List.length const_args
+ then None
+ else Some (List.map (fun cst -> Lconst cst) const_args)
+ | _ -> None
+ end
+
let beta_reduce params body args =
List.fold_left2 (fun l (param, kind) arg -> Llet(Strict, kind, param, arg, l))
body params args
| Lconst _ -> ()
| Lvar v ->
use_var bv v 1
- | Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args}
- when optimize && List.length params = List.length args ->
- count bv (beta_reduce params body args)
- | Lapply{ap_func = Lfunction{kind = Tupled; params; body};
- ap_args = [Lprim(Pmakeblock _, args, _)]}
- when optimize && List.length params = List.length args ->
- count bv (beta_reduce params body args)
- | Lapply{ap_func = l1; ap_args = ll} ->
- count bv l1; List.iter (count bv) ll
+ | Lapply{ap_func = ll; ap_args = args} ->
+ let no_opt () = count bv ll; List.iter (count bv) args in
+ begin match ll with
+ | Lfunction lf when optimize ->
+ begin match exact_application lf args with
+ | None -> no_opt ()
+ | Some exact_args ->
+ count bv (beta_reduce lf.params lf.body exact_args)
+ end
+ | _ -> no_opt ()
+ end
| Lfunction {body} ->
count Ident.Map.empty body
| Llet(_str, _k, v, Lvar w, l2) when optimize ->
l
end
| Lconst _ as l -> l
- | Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args}
- when optimize && List.length params = List.length args ->
- simplif (beta_reduce params body args)
- | Lapply{ap_func = Lfunction{kind = Tupled; params; body};
- ap_args = [Lprim(Pmakeblock _, args, _)]}
- when optimize && List.length params = List.length args ->
- simplif (beta_reduce params body args)
- | Lapply ap -> Lapply {ap with ap_func = simplif ap.ap_func;
- ap_args = List.map simplif ap.ap_args}
+ | Lapply ({ap_func = ll; ap_args = args} as ap) ->
+ let no_opt () =
+ Lapply {ap with ap_func = simplif ap.ap_func;
+ ap_args = List.map simplif ap.ap_args} in
+ begin match ll with
+ | Lfunction lf when optimize ->
+ begin match exact_application lf args with
+ | None -> no_opt ()
+ | Some exact_args ->
+ simplif (beta_reduce lf.params lf.body exact_args)
+ end
+ | _ -> no_opt ()
+ end
| Lfunction{kind; params; return=return1; body = l; attr; loc} ->
begin match simplif l with
Lfunction{kind=Curried; params=params'; return=return2; body; attr; loc}
let new_l = simplif l
and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
and new_blocks = List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
- and new_fail = Misc.may_map simplif sw.sw_failaction in
+ and new_fail = Option.map simplif sw.sw_failaction in
Lswitch
(new_l,
{sw with sw_consts = new_consts ; sw_blocks = new_blocks;
| Lstringswitch (l,sw,d,loc) ->
Lstringswitch
(simplif l,List.map (fun (s,l) -> s,simplif l) sw,
- Misc.may_map simplif d,loc)
+ Option.map simplif d,loc)
| Lstaticraise (i,ls) ->
Lstaticraise (i, List.map simplif ls)
| Lstaticcatch(l1, (i,args), l2) ->
emit_tail_infos false lam;
list_emit_tail_infos_fun snd is_tail sw.sw_consts;
list_emit_tail_infos_fun snd is_tail sw.sw_blocks;
- Misc.may (emit_tail_infos is_tail) sw.sw_failaction
+ Option.iter (emit_tail_infos is_tail) sw.sw_failaction
| Lstringswitch (lam, sw, d, _) ->
emit_tail_infos false lam;
List.iter
(fun (_,lam) -> emit_tail_infos is_tail lam)
sw ;
- Misc.may (emit_tail_infos is_tail) d
+ Option.iter (emit_tail_infos is_tail) d
| Lstaticraise (_, l) ->
list_emit_tail_infos false l
| Lstaticcatch (body, _, handler) ->
type slot =
{
- nargs: int;
+ func: lfunction;
mutable scope: lambda option;
}
-> false
in
let rec tail = function
- | Llet (_str, _kind, id, Lfunction lf, cont)
- when Lambda.function_is_curried lf && enabled lf.attr ->
- let r = {nargs=List.length lf.params; scope=None} in
+ | Llet (_str, _kind, id, Lfunction lf, cont) when enabled lf.attr ->
+ let r = {func = lf; scope = None} in
Hashtbl.add slots id r;
tail cont;
begin match Hashtbl.find_opt slots id with
end
| Lapply {ap_func = Lvar id; ap_args; _} ->
begin match Hashtbl.find_opt slots id with
- | Some {nargs; _} when nargs <> List.length ap_args ->
+ | Some {func; _}
+ when exact_application func ap_args = None ->
(* Wrong arity *)
Hashtbl.remove slots id
| Some {scope = Some scope; _} when scope != !current_scope ->
| Llet (_, _, id, _, cont) when Hashtbl.mem static_id id ->
rewrite cont
| Lapply {ap_func = Lvar id; ap_args; _} when Hashtbl.mem static_id id ->
- Lstaticraise (Hashtbl.find static_id id, List.map rewrite ap_args)
+ let st = Hashtbl.find static_id id in
+ let slot = Hashtbl.find slots id in
+ begin match exact_application slot.func ap_args with
+ | None -> assert false
+ | Some exact_args ->
+ Lstaticraise (st, List.map rewrite exact_args)
+ end
| lam ->
Lambda.shallow_map rewrite lam
in
and right = {s with cases=right} in
if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then
- make_if_ne
- ctx.arg 0
+ Arg.make_if
+ ctx.arg
(c_test ctx right) (c_test ctx left)
else if less_tests cright cleft then
make_if_lt
type binding =
| Bind_value of value_binding list
- | Bind_module of Ident.t * string loc * module_presence * module_expr
+ | Bind_module of Ident.t * string option loc * module_presence * module_expr
let rec push_defaults loc bindings cases partial =
match cases with
| [{c_lhs=pat; c_guard=None;
c_rhs={exp_attributes=[{Parsetree.attr_name = {txt="#modulepat"};_}];
exp_desc = Texp_letmodule
- (id, name, pres, mexpr,
+ (Some id, name, pres, mexpr,
({exp_desc = Texp_function _} as e2))}}] ->
push_defaults loc (Bind_module (id, name, pres, mexpr) :: bindings)
[{c_lhs=pat;c_guard=None;c_rhs=e2}]
match binds with
| Bind_value binds -> Texp_let(Nonrecursive, binds, exp)
| Bind_module (id, name, pres, mexpr) ->
- Texp_letmodule (id, name, pres, mexpr, exp)})
+ Texp_letmodule (Some id, name, pres, mexpr, exp)})
case.c_rhs bindings
in
[{case with c_rhs=exp}]
(Lvar cpy) var expr, rem))
modifs
(Lvar cpy))
- | Texp_letmodule(id, loc, Mp_present, modl, body) ->
+ | Texp_letmodule(None, loc, Mp_present, modl, body) ->
+ let lam = !transl_module Tcoerce_none None modl in
+ Lsequence(Lprim(Pignore, [lam], loc.loc), transl_exp body)
+ | Texp_letmodule(Some id, loc, Mp_present, modl, body) ->
let defining_expr =
Levent (!transl_module Tcoerce_none None modl, {
lev_loc = loc.loc;
in
let args, args' =
if List.for_all (fun (_,opt) -> opt) args then [], args
- else args, [] in
+ else args, []
+ in
let lam =
- if args = [] then lam else lapply lam (List.rev_map fst args) in
- let handle = protect "func" lam
- and l = List.map (fun (arg, opt) -> may_map (protect "arg") arg, opt) l
- and id_arg = Ident.create_local "param" in
+ if args = [] then lam else lapply lam (List.rev_map fst args)
+ in
+ let handle = protect "func" lam in
+ let l =
+ List.map (fun (arg, opt) -> Option.map (protect "arg") arg, opt) l
+ in
+ let id_arg = Ident.create_local "param" in
let body =
match build_apply handle ((Lvar id_arg, optional)::args') l with
Lfunction{kind = Curried; params = ids; return;
lapply lam (List.rev_map fst args)
in
(build_apply lam [] (List.map (fun (l, x) ->
- may_map transl_exp x, Btype.is_optional l)
+ Option.map transl_exp x, Btype.is_optional l)
sargs)
: Lambda.lambda)
| Unsafe_non_function
| Unsafe_typext
-type unsafe_info = { reason:unsafe_component; loc:Location.t; subid:Ident.t }
+type unsafe_info =
+ | Unsafe of { reason:unsafe_component; loc:Location.t; subid:Ident.t }
+ | Unnamed
type error =
Circular_dependency of (Ident.t * unsafe_info) list
| Conflicting_inline_attributes
exception Error of Location.t * error
+let cons_opt x_opt xs =
+ match x_opt with
+ | None -> xs
+ | Some x -> x :: xs
+
(* Keep track of the root path (from the root of the namespace to the
currently compiled module expression). Useful for naming extensions. *)
match Mtype.scrape env mty with
Mty_ident _
| Mty_alias _ ->
- raise (Initialization_failure {reason=Unsafe_module_binding;loc;subid})
+ raise (Initialization_failure
+ (Unsafe {reason=Unsafe_module_binding;loc;subid}))
| Mty_signature sg ->
Const_block(0, [Const_block(0, init_shape_struct env sg)])
| Mty_functor _ ->
(* can we do better? *)
- raise (Initialization_failure {reason=Unsafe_functor;loc;subid})
+ raise (Initialization_failure
+ (Unsafe {reason=Unsafe_functor;loc;subid}))
and init_shape_struct env sg =
match sg with
[] -> []
| {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
Const_pointer 1 (* camlinternalMod.Lazy *)
| _ ->
- let not_a_function = {reason=Unsafe_non_function; loc; subid } in
+ let not_a_function =
+ Unsafe {reason=Unsafe_non_function; loc; subid }
+ in
raise (Initialization_failure not_a_function) in
init_v :: init_shape_struct env rem
| Sig_value(_, {val_kind=Val_prim _}, _) :: rem ->
| Sig_type(id, tdecl, _, _) :: rem ->
init_shape_struct (Env.add_type ~check:false id tdecl env) rem
| Sig_typext (subid, {ext_loc=loc},_,_) :: _ ->
- raise (Initialization_failure {reason=Unsafe_typext; loc; subid})
+ raise (Initialization_failure (Unsafe {reason=Unsafe_typext;loc;subid}))
| Sig_module(id, Mp_present, md, _, _) :: rem ->
init_shape_mod id md.md_loc env md.md_type ::
init_shape_struct (Env.add_module_declaration ~check:false
| Inprogress of int option (** parent node *)
| Defined
+type id_or_ignore_loc =
+ | Id of Ident.t
+ | Ignore_loc of Location.t
+
let extract_unsafe_cycle id status init cycle_start =
let info i = match init.(i) with
- | Result.Error r -> id.(i), r
+ | Result.Error r ->
+ begin match id.(i) with
+ | Id id -> id, r
+ | Ignore_loc _ ->
+ assert false (* Can't refer to something without a name. *)
+ end
| Ok _ -> assert false in
let rec collect stop l i = match status.(i) with
| Inprogress None | Undefined | Defined -> assert false
if is_unsafe i then begin
status.(i) <- Inprogress parent;
for j = 0 to num_bindings - 1 do
- if Ident.Set.mem id.(j) fv.(i) then emit_binding (Some i) j
+ match id.(j) with
+ | Id id when Ident.Set.mem id fv.(i) -> emit_binding (Some i) j
+ | _ -> ()
done
end;
res := (id.(i), init_res i, rhs.(i)) :: !res;
let rec bind_inits = function
[] ->
bind_strict bindings
- | (_id, None, _rhs) :: rem ->
+ | (Ignore_loc _, _, _) :: rem
+ | (_, None, _) :: rem ->
bind_inits rem
- | (id, Some(loc, shape), _rhs) :: rem ->
+ | (Id id, Some(loc, shape), _rhs) :: rem ->
Llet(Strict, Pgenval, id,
Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
and bind_strict = function
[] ->
patch_forwards bindings
- | (id, None, rhs) :: rem ->
+ | (Ignore_loc loc, None, rhs) :: rem ->
+ Lsequence(Lprim(Pignore, [rhs], loc), bind_strict rem)
+ | (Id id, None, rhs) :: rem ->
Llet(Strict, Pgenval, id, rhs, bind_strict rem)
| (_id, Some _, _rhs) :: rem ->
bind_strict rem
and patch_forwards = function
[] ->
cont
- | (_id, None, _rhs) :: rem ->
+ | (Ignore_loc _, _, _rhs) :: rem
+ | (_, None, _rhs) :: rem ->
patch_forwards rem
- | (id, Some(_loc, shape), rhs) :: rem ->
+ | (Id id, Some(_loc, shape), rhs) :: rem ->
Lsequence(Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=mod_prim "update_mod";
eval_rec_bindings
(reorder_rec_bindings
(List.map
- (fun {mb_id=id; mb_expr=modl; mb_loc=loc; _} ->
- (id, modl.mod_loc, init_shape id modl, compile_rhs id modl loc))
+ (fun {mb_id=id; mb_name; mb_expr=modl; mb_loc=loc; _} ->
+ let id_or_ignore_loc, shape =
+ match id with
+ | None -> Ignore_loc mb_name.loc, Result.Error Unnamed
+ | Some id -> Id id, init_shape id modl
+ in
+ (id_or_ignore_loc, modl.mod_loc, shape, compile_rhs id modl loc))
bindings))
cont
let rec merge mexp coercion path acc inline_attribute =
let finished = acc, mexp, path, coercion, inline_attribute in
match mexp.mod_desc with
- | Tmod_functor (param, _, _, body) ->
+ | Tmod_functor (param, body) ->
let inline_attribute' =
Translattribute.get_inline_attribute mexp.mod_attributes
in
| _ -> fatal_error "Translmod.merge_functors: bad coercion"
in
let loc = mexp.mod_loc in
- let path = functor_path path param in
+ let path, param =
+ match param with
+ | Unit -> None, Ident.create_local "*"
+ | Named (None, _, _) ->
+ let id = Ident.create_local "_" in
+ functor_path path id, id
+ | Named (Some id, _, _) -> functor_path path id, id
+ in
let inline_attribute =
merge_inline_attributes inline_attribute inline_attribute' loc
in
Lsequence(transl_exp expr, body), size
| Tstr_value(rec_flag, pat_expr_list) ->
(* Translate bindings first *)
- let mk_lam_let = transl_let rec_flag pat_expr_list in
- let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
+ let mk_lam_let = transl_let rec_flag pat_expr_list in
+ let ext_fields =
+ List.rev_append (let_bound_idents pat_expr_list) fields in
(* Then, translate remainder of struct *)
let body, size =
transl_structure loc ext_fields cc rootpath final_env rem
let id = mb.mb_id in
(* Translate module first *)
let module_body =
- transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr
+ transl_module Tcoerce_none (Option.bind id (field_path rootpath))
+ mb.mb_expr
in
let module_body =
Translattribute.add_inline_attribute module_body mb.mb_loc
in
(* Translate remainder second *)
let body, size =
- transl_structure loc (id :: fields) cc rootpath final_env rem
- in
- let module_body =
- Levent (module_body, {
- lev_loc = mb.mb_loc;
- lev_kind = Lev_module_definition id;
- lev_repr = None;
- lev_env = Env.empty;
- })
+ transl_structure loc (cons_opt id fields) cc rootpath final_env rem
in
- Llet(pure_module mb.mb_expr, Pgenval, id,
- module_body,
- body), size
+ begin match id with
+ | None ->
+ Lsequence (Lprim(Pignore, [module_body], mb.mb_name.loc), body),
+ size
+ | Some id ->
+ let module_body =
+ Levent (module_body, {
+ lev_loc = mb.mb_loc;
+ lev_kind = Lev_module_definition id;
+ lev_repr = None;
+ lev_env = Env.empty;
+ })
+ in
+ Llet(pure_module mb.mb_expr, Pgenval, id, module_body, body), size
+ end
| Tstr_module {mb_presence=Mp_absent} ->
transl_structure loc fields cc rootpath final_env rem
| Tstr_recmodule bindings ->
let ext_fields =
- List.rev_append (List.map (fun mb -> mb.mb_id) bindings) fields
+ List.rev_append (List.filter_map (fun mb -> mb.mb_id) bindings)
+ fields
in
let body, size =
transl_structure loc ext_fields cc rootpath final_env rem
in
let lam =
- compile_recmodule
- (fun id modl loc ->
- let module_body =
- transl_module Tcoerce_none (field_path rootpath id) modl
- in
- Levent (module_body, {
- lev_loc = loc;
- lev_kind = Lev_module_definition id;
- lev_repr = None;
- lev_env = Env.empty;
- }))
- bindings
- body
+ compile_recmodule (fun id modl loc ->
+ match id with
+ | None -> transl_module Tcoerce_none None modl
+ | Some id ->
+ let module_body =
+ transl_module Tcoerce_none (field_path rootpath id) modl
+ in
+ Levent (module_body, {
+ lev_loc = loc;
+ lev_kind = Lev_module_definition id;
+ lev_repr = None;
+ lev_env = Env.empty;
+ })
+ ) bindings body
in
lam, size
| Tstr_class cl_list ->
List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
@ defined_idents rem
| Tstr_exception ext -> ext.tyexn_constructor.ext_id :: defined_idents rem
- | Tstr_module {mb_id; mb_presence=Mp_present} -> mb_id :: defined_idents rem
- | Tstr_module {mb_presence=Mp_absent} -> defined_idents rem
+ | Tstr_module {mb_id = Some id; mb_presence=Mp_present} ->
+ id :: defined_idents rem
+ | Tstr_module ({mb_id = None}
+ |{mb_presence=Mp_absent}) -> defined_idents rem
| Tstr_recmodule decls ->
- List.map (fun mb -> mb.mb_id) decls @ defined_idents rem
+ List.filter_map (fun mb -> mb.mb_id) decls @ defined_idents rem
| Tstr_modtype _ -> defined_idents rem
| Tstr_open od ->
bound_value_identifiers od.open_bound_items @ defined_idents rem
@ all_idents rem
| Tstr_exception ext -> ext.tyexn_constructor.ext_id :: all_idents rem
| Tstr_recmodule decls ->
- List.map (fun mb -> mb.mb_id) decls @ all_idents rem
+ List.filter_map (fun mb -> mb.mb_id) decls @ all_idents rem
| Tstr_modtype _ -> all_idents rem
| Tstr_open od ->
let rest = all_idents rem in
bound_value_identifiers incl.incl_type @ all_idents rem
| Tstr_module
- {mb_id;mb_presence=Mp_present;mb_expr={mod_desc = Tmod_structure str}}
+ { mb_id = Some id;
+ mb_presence=Mp_present;
+ mb_expr={mod_desc = Tmod_structure str} }
| Tstr_module
- {mb_id;mb_presence=Mp_present;
- mb_expr=
- {mod_desc =
- Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
- mb_id :: all_idents str.str_items @ all_idents rem
- | Tstr_module {mb_id;mb_presence=Mp_present} -> mb_id :: all_idents rem
- | Tstr_module {mb_presence=Mp_absent} -> all_idents rem
+ { mb_id = Some id;
+ mb_presence = Mp_present;
+ mb_expr =
+ {mod_desc =
+ Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
+ id :: all_idents str.str_items @ all_idents rem
+ | Tstr_module {mb_id = Some id;mb_presence=Mp_present} ->
+ id :: all_idents rem
+ | Tstr_module ({mb_id = None} | {mb_presence=Mp_absent}) -> all_idents rem
| Tstr_attribute _ -> all_idents rem
store_ident ext.tyexn_constructor.ext_loc id),
transl_store rootpath
(add_ident false id subst) cont rem)
- | Tstr_module{mb_id=id;mb_loc=loc;mb_presence=Mp_present;
+ | Tstr_module
+ {mb_id=None; mb_name; mb_presence=Mp_present; mb_expr=modl;
+ mb_loc=loc; mb_attributes} ->
+ let lam =
+ Translattribute.add_inline_attribute
+ (transl_module Tcoerce_none None modl)
+ loc mb_attributes
+ in
+ Lsequence(Lprim(Pignore, [lam], mb_name.loc),
+ transl_store rootpath subst cont rem)
+ | Tstr_module{mb_id=Some id;mb_loc=loc;mb_presence=Mp_present;
mb_expr={mod_desc = Tmod_structure str} as mexp;
mb_attributes} ->
List.iter (Translattribute.check_attribute_on_module mexp)
(add_ident true id subst)
cont rem)))
| Tstr_module{
- mb_id=id;mb_loc=loc;mb_presence=Mp_present;
+ mb_id=Some id;mb_loc=loc;mb_presence=Mp_present;
mb_expr= {
mod_desc = Tmod_constraint (
{mod_desc = Tmod_structure str} as mexp, _, _,
(add_ident true id subst)
cont rem)))
| Tstr_module
- {mb_id=id; mb_presence=Mp_present; mb_expr=modl;
+ {mb_id=Some id; mb_presence=Mp_present; mb_expr=modl;
mb_loc=loc; mb_attributes} ->
let lam =
Translattribute.add_inline_attribute
| Tstr_module {mb_presence=Mp_absent} ->
transl_store rootpath subst cont rem
| Tstr_recmodule bindings ->
- let ids = List.map (fun mb -> mb.mb_id) bindings in
+ let ids = List.filter_map (fun mb -> mb.mb_id) bindings in
compile_recmodule
(fun id modl _loc ->
Lambda.subst no_env_update subst
(transl_module Tcoerce_none
- (field_path rootpath id) modl))
+ (Option.bind id (field_path rootpath)) modl))
bindings
(Lsequence(store_idents Location.none ids,
transl_store rootpath (add_idents true ids subst)
set_toplevel_unique_name ext.tyexn_constructor.ext_id;
toploop_setvalue ext.tyexn_constructor.ext_id
(transl_extension_constructor item.str_env None ext.tyexn_constructor)
- | Tstr_module {mb_id=id; mb_presence=Mp_present; mb_expr=modl} ->
+ | Tstr_module {mb_id=None; mb_presence=Mp_present; mb_expr=modl} ->
+ transl_module Tcoerce_none None modl
+ | Tstr_module {mb_id=Some id; mb_presence=Mp_present; mb_expr=modl} ->
(* we need to use the unique name for the module because of issues
with "open" (PR#8133) *)
set_toplevel_unique_name id;
let lam = transl_module Tcoerce_none (Some(Pident id)) modl in
toploop_setvalue id lam
| Tstr_recmodule bindings ->
- let idents = List.map (fun mb -> mb.mb_id) bindings in
+ let idents = List.filter_map (fun mb -> mb.mb_id) bindings in
compile_recmodule
- (fun id modl _loc -> transl_module Tcoerce_none (Some(Pident id)) modl)
+ (fun id modl _loc ->
+ transl_module Tcoerce_none (Option.map (fun i -> Pident i) id) modl)
bindings
(make_sequence toploop_setvalue_id idents)
| Tstr_class cl_list ->
(Ident.name @@ fst @@ List.hd cycle)
(* we repeat the first element to make the cycle more apparent *)
-let explanation_submsg (id, {reason;loc;subid}) =
- let print fmt =
- let printer = Format.dprintf fmt (Ident.name id) (Ident.name subid) in
- Location.mkloc printer loc in
- match reason with
- | Unsafe_module_binding -> print "Module %s defines an unsafe module, %s ."
- | Unsafe_functor -> print "Module %s defines an unsafe functor, %s ."
- | Unsafe_typext ->
- print "Module %s defines an unsafe extension constructor, %s ."
- | Unsafe_non_function -> print "Module %s defines an unsafe value, %s ."
+let explanation_submsg (id, unsafe_info) =
+ match unsafe_info with
+ | Unnamed -> assert false (* can't be part of a cycle. *)
+ | Unsafe {reason;loc;subid} ->
+ let print fmt =
+ let printer = Format.dprintf fmt (Ident.name id) (Ident.name subid) in
+ Location.mkloc printer loc in
+ match reason with
+ | Unsafe_module_binding ->
+ print "Module %s defines an unsafe module, %s ."
+ | Unsafe_functor -> print "Module %s defines an unsafe functor, %s ."
+ | Unsafe_typext ->
+ print "Module %s defines an unsafe extension constructor, %s ."
+ | Unsafe_non_function -> print "Module %s defines an unsafe value, %s ."
let report_error loc = function
| Circular_dependency cycle ->
- let[@manual.ref "s-recursive-modules"] chapter, section = 8, 2 in
+ let[@manual.ref "s:recursive-modules"] chapter, section = 8, 2 in
Location.errorf ~loc ~sub:(List.map explanation_submsg cycle)
"Cannot safely evaluate the definition of the following cycle@ \
of recursively-defined modules:@ %a.@ \
| Unsafe_non_function
| Unsafe_typext
-type unsafe_info = { reason:unsafe_component; loc:Location.t; subid:Ident.t }
+type unsafe_info =
+ | Unsafe of { reason:unsafe_component; loc:Location.t; subid:Ident.t }
+ | Unnamed
type error =
Circular_dependency of (Ident.t * unsafe_info) list
CAMLC = $(BOOT_OCAMLC) -strict-sequence -nostdlib \
-I $(ROOTDIR)/boot -use-prims $(ROOTDIR)/runtime/primitives
CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
-COMPFLAGS = $(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
-safe-string -strict-sequence -strict-formats -bin-annot
LINKFLAGS =
YACCFLAGS = -v
beforedepend:: parser.ml parser.mli
lexer.ml: lexer.mll
- $(CAMLLEX) lexer.mll
+ $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
clean::
rm -f lexer.ml
ROOTDIR = ..
include $(ROOTDIR)/Makefile.config
+DESTDIR ?=
INSTALL_DIR=$(DESTDIR)$(MANDIR)/man$(PROGRAMS_MAN_SECTION)
install:
giving control to the user. The default file is
.B .ocamlinit
in the current directory if it exists, otherwise
+.B XDG_CONFIG_HOME/ocaml/init.ml
+according to the XDG base directory specification lookup if it exists (on
+Windows this is skipped), otherwise
.B .ocamlinit
-in the user's home directory. You can specify a different initialization file
+in the user's home directory (
+.B HOME
+variable).
+You can specify a different initialization file
by using the
.BI \-init \ file
option, and disable initialization files by using the
attempts to underline visually the location of the error. It
consults the TERM variable to determines the type of output terminal
and look up its capabilities in the terminal database.
-
+.TP
+.B XDG_CONFIG_HOME HOME
+.B .ocamlinit
+lookup procedure (see above).
.SH SEE ALSO
.BR ocamlc (1), \ ocamlopt (1), \ ocamlrun (1).
.br
.IP
The default setting is
-.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-32..42\-44\-45\-48\-50\-60\-66 .
+.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66 .
Note that warnings
.BR 5 \ and \ 10
are not always triggered, depending on the internals of the type checker.
.TP
.BR a \ (allocation_policy)
The policy used for allocating in the OCaml heap. Possible values
-are 0 for the next-fit policy, and 1 for the first-fit
-policy. Next-fit is usually faster, but first-fit is better for
-avoiding fragmentation and the associated heap compactions.
+are 0 for the next-fit policy, 1 for the first-fit
+policy, and 2 for the best-fit policy. Best-fit is still experimental,
+but probably the best of the three. The default is 0.
+See the Gc module documentation for details.
.TP
.BR s \ (minor_heap_size)
The size of the minor heap (in words).
-The present documentation is copyright Institut National de Recherche
-en Informatique et en Automatique (INRIA).
+The OCaml documentation and user's manual is copyright
+Institut National de Recherche en Informatique et en Automatique (INRIA).
-The OCaml documentation and user's manual may be reproduced and
-distributed in whole or in part, subject to the following conditions:
+The OCaml documentation and user's manual is licensed under a Creative
+Commons Attribution-ShareAlike 4.0 International License (CC BY-SA 4.0)
+https://creativecommons.org/licenses/by-sa/4.0/
-- The copyright notice above and this permission notice must be
- preserved complete on all complete or partial copies.
+This is a human-readable summary of (and not a substitute for) the
+license, which is available at
+https://creativecommons.org/licenses/by-sa/4.0/legalcode
-- Any translation or derivative work of the OCaml documentation and
- user's manual must be approved by the authors in writing before
- distribution.
+You are free to:
-- If you distribute the OCaml documentation and user's manual in part,
- instructions for obtaining the complete version of this manual must
- be included, and a means for obtaining a complete version provided.
+Share - copy and redistribute the material in any medium or format
+
+Adapt - remix, transform, and build upon the material
+ for any purpose, even commercially.
+
+The licensor cannot revoke these freedoms as long as you follow the
+license terms.
+
+Under the following terms:
+
+Attribution - You must give appropriate credit, provide a link to
+ the license, and indicate if changes were made. You may do so in
+ any reasonable manner, but not in any way that suggests the
+ licensor endorses you or your use.
+
+ShareAlike - If you remix, transform, or build upon the material,
+ you must distribute your contributions under the same license as
+ the original.
+
+No additional restrictions - You may not apply legal terms or
+ technological measures that legally restrict others from doing
+ anything the license permits.
-- Small portions may be reproduced as illustrations for reviews or
- quotes in other works without this permission notice if proper
- citation is given.
Latex extensions
----------------
+### Sections (and subsections, and subsubsections)
+
+In order to provide stable links to all part of the manual, the standard
+`\section`, `\subsection` and `\subsubsection` macros are replaced by
+variants that take the section label as their first argument.
+For instance, in the manual, you have to write
+```latex
+\section{s:basics}{Basics}
+```
+rather than
+```latex
+\section{Basics\label{s:basics}}
+```
+This restriction ensures that hevea picks the section label when generating the
+header ids.
+
+A similar macro, `\lparagraph`, is provided for paragraphs.
+
### Caml environments
The tool `tools/caml-tex` is used to generate the latex code for the examples
RELEASE = $$HOME/release/$${RELEASENAME}
HEVEA = hevea
HACHA = hacha
-INFO_FLAGS = -fix -exec xxdate.exe -info -w 79
+# We suppress warnings in info and text mode (with -s) because hevea listings emit
+# DIV blocks that the text modes do not know how to interpret.
+INFO_FLAGS = -fix -exec xxdate.exe -info -w 79 -s
HTML_FLAGS = -fix -exec xxdate.exe -O
-TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79
+TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 -s
manual: files
--- /dev/null
+%hevea book class with anchor links in headers
+\input{bookcommon.hva}
+\newcommand{\@book@attr}[1]{\@secid\envclass@attr{#1}}
+\newcommand{\@titlesecanchor}{\@open{a}{class="section-anchor" href="\#\@sec@id@attr" aria-hidden="true"}\@print@u{xfeff}\@close{a}}
+\@makesection
+ {\part}{-2}{part}
+ {\@opencell{class="center"}{}{}\@open{h1}{\@book@attr{part}}}%
+ {\partname~\thepart}{\\}%
+ {\@close{h1}\@closecell}
+\newstyle{.part}{margin:2ex auto;text-align:center}
+\@makesection
+ {\chapter}{-1}{chapter}
+ {\@open{h1}{\@book@attr{chapter}}}{\chaptername~\thechapter}{\quad}{\@close{h1}}
+\@makesection
+ {\section}{0}{section}
+ {\@open{h2}{\@book@attr{section}}\@titlesecanchor}{\thesection}{\quad}{\@close{h2}}%
+\@makesection
+ {\subsection}{1}{subsection}
+ {\@open{h3}{\@book@attr{subsection}}\@titlesecanchor}{\thesubsection}{\quad}{\@close{h3}}%
+\@makesection
+ {\subsubsection}{2}{subsubsection}
+ {\@open{h4}{\@book@attr{subsubsection}}\@titlesecanchor}{\thesubsubsection}{\quad}{\@close{h4}}%
+\@makesection
+ {\paragraph}{3}{paragraph}
+ {\@open{h5}{\@book@attr{paragraph}}\@titlesecanchor}{\theparagraph}{\quad}{\@close{h5}}%
+\@makesection
+ {\subparagraph}{4}{subparagraph}
+ {\@open{h6}{\@book@attr{subparagraph}}\@titlesecanchor}{\thesubparagraph}{\quad}{\@close{h6}}%
+\newcommand{\hacha@style}{book}%
+\styleloadedtrue
\chapter{Fuzzing with afl-fuzz}
%HEVEA\cutname{afl-fuzz.html}
-\section{Overview}
+\section{s:afl-overview}{Overview}
American fuzzy lop (``afl-fuzz'') is a {\em fuzzer}, a tool for
testing software by providing randomly-generated inputs, searching for
{\tt http://lcamtuf.coredump.cx/afl/}
\fi
-\section{Generating instrumentation}
+\section{s:afl-generate}{Generating instrumentation}
The instrumentation that afl-fuzz requires is not generated by
default, and must be explicitly enabled, by passing the {\tt
OCaml is configured with {\tt afl-instrument}, then all programs
compiled by {\tt ocamlopt} will be instrumented.
-\subsection{Advanced options}
+\subsection{ss:afl-advanced}{Advanced options}
In rare cases, it is useful to control the amount of instrumentation
generated. By passing the {\tt -afl-inst-ratio N} argument to {\tt
generated for only N\% of branches. (See the afl-fuzz documentation on
the parameter {\tt AFL\_INST\_RATIO} for the precise effect of this).
-\section{Example}
+\section{s:afl-example}{Example}
As an example, we fuzz-test the following program, {\tt readline.ml}:
These executable files are then run by the bytecode interpreter
"ocamlrun".
-\section{Overview of the compiler}
+\section{s:comp-overview}{Overview of the compiler}
The "ocamlc" command has a command-line interface similar to the one of
most C compilers. It accepts several types of arguments and processes them
These ".cmt" and ".cmti" files are typically useful for code inspection tools.
-\section{Options}\label{s:comp-options}
+\section{s:comp-options}{Options}
The following command-line options are recognized by "ocamlc".
The options "-pack", "-a", "-c" and "-output-obj" are mutually exclusive.
% compilers and toplevel
\input{unified-options.tex}
-\paragraph{Contextual control of command-line options}
+\paragraph{contextual-cli-control}{Contextual control of command-line options}
The compiler command line can be modified ``from the outside''
with the following mechanisms. These are experimental
configured value. Primarily used for bootstrapping.
\end{options}
-\section{Modules and the file system}
+\section{s:modules-file-system}{Modules and the file system}
This short section is intended to clarify the relationship between the
names of the modules corresponding to compilation units and the names
given name: it relies instead on the user providing the list of ".cmo"
files by hand.
-\section{Common errors} \label{s:comp-errors}
+\section{s:comp-errors}{Common errors}
This section describes and explains the most frequently encountered
error messages.
\end{options}
-\section{Warning reference} \label{s:comp-warnings}
+\section{s:comp-warnings}{Warning reference}
This section describes and explains in detail some warnings:
-\subsection{Warning 9: missing fields in a record pattern}
+\subsection{ss:warn9}{Warning 9: missing fields in a record pattern}
When pattern matching on records, it can be useful to match only few
fields of a record. Eliding fields can be done either implicitly
let dy { y; _ } = y (* explicit field elision: do not trigger warning 9 *)
\end{verbatim}
-\subsection{Warning 52: fragile constant pattern}
-\label{ss:warn52}
+\subsection{ss:warn52}{Warning 52: fragile constant pattern}
Some constructors, such as the exception constructors "Failure" and
"Invalid_argument", take as parameter a "string" value holding
| Failure "bool_of_string" -> (-1, false)
\end{verbatim}
should be rewritten into more atomic tests. For example,
- using the "exception" patterns documented in Section~\ref{s:exception-match},
+ using the "exception" patterns documented in Section~\ref{sss:exception-match},
one can write:
\begin{verbatim}
match int_of_string count_str with
discouraged: it's better to define more precise exception constructors
than store useful information in strings.
-\subsection{Warning 57: Ambiguous or-pattern variables under guard}
-\label{ss:warn57}
+\subsection{ss:warn57}{Warning 57: Ambiguous or-pattern variables under guard}
The semantics of or-patterns in OCaml is specified with
a left-to-right bias: a value \var{v} matches the pattern \var{p} "|" \var{q}
OCaml, but not under the native Win32 ports.
\end{windows}
-\section{Compiling for debugging}
+\section{s:debugger-compilation}{Compiling for debugging}
Before the debugger can be used, the program must be compiled and
linked with the "-g" option: all ".cmo" and ".cma" files that are part
take longer to produce, but the executable files run at
exactly the same speed as if they had been compiled without "-g".
-\section{Invocation}
+\section{s:debugger-invocation}{Invocation}
-\subsection{Starting the debugger}
+\subsection{ss:debugger-start}{Starting the debugger}
The OCaml debugger is invoked by running the program
"ocamldebug" with the name of the bytecode executable file as first
\item["-s "\var{socket}]
Use \var{socket} for communicating with the debugged program. See the
-description of the command "set socket" (section~\ref{s:communication})
+description of the command "set socket" (section~\ref{ss:debugger-communication})
for the format of \var{socket}.
\item["-version"]
%
\end{options}
-\subsection{Initialization file}
+\subsection{ss:debugger-init-file}{Initialization file}
On start-up, the debugger will read commands from an initialization
file before giving control to the user. The default file is
".ocamldebug" in the current directory if it exists, otherwise
".ocamldebug" in the user's home directory.
-\subsection{Exiting the debugger}
+\subsection{ss:debugger-exut}{Exiting the debugger}
The command "quit" exits the debugger. You can also exit the debugger
by typing an end-of-file character (usually "ctrl-D").
Typing an interrupt character (usually "ctrl-C") will not exit the
debugger, but will terminate the action of any debugger command that is in
-progress and return to the debugger command level.
+progress and return to the debugger command level.
-\section{Commands} \label{s:debugger-commands}
+\section{s:debugger-commands}{Commands}
A debugger command is a single line of input. It starts with a command
name, which is followed by arguments depending on this name. Examples:
If the previous command has been successful, a blank line (typing just
"RET") will repeat it.
-\subsection{Getting help}
+\subsection{ss:debugger-help}{Getting help}
The OCaml debugger has a simple on-line help system, which gives
a brief description of each command and variable.
Give help about \var{topic}. Use "help info" to get a list of known topics.
\end{options}
-\subsection{Accessing the debugger state}
+\subsection{ss:debugger-state}{Accessing the debugger state}
\begin{options}
\item["set "\var{variable} \var{value}]
For instance, "info breakpoints" will print the list of all breakpoints.
\end{options}
-\section{Executing a program}
+\section{s:debugger-execution}{Executing a program}
-\subsection{Events}
+\subsection{ss:debugger-events}{Events}
Events are ``interesting'' locations in the source code, corresponding
to the beginning or end of evaluation of ``interesting''
% Also, no event is put after a function application when the function
% is external (written in C).
-\subsection{Starting the debugged program}
+\subsection{ss:debugger-starting-program}{Starting the debugged program}
The debugger starts executing the debugged program only when needed.
This allows setting breakpoints or assigning debugger variables before
to change the arguments or the working directory after starting your
program, the debugger will kill the program (after asking for confirmation).
-\subsection{Running the program}
+\subsection{ss:debugger-running}{Running the program}
The following commands execute the program forward or backward,
starting at the current time. The execution will stop either when
before the current function invocation.
\end{options}
-\subsection{Time travel}
+\subsection{ss:debugger-time-travel}{Time travel}
You can jump directly to a given time, without stopping on
breakpoints, using the "goto" command.
Set the size of the execution history.
\end{options}
-\subsection{Killing the program}
+\subsection{ss:debugger-kill}{Killing the program}
\begin{options}
\item["kill"] Kill the program being executed. This command is mainly
useful if you wish to recompile the program without leaving the debugger.
\end{options}
-\section{Breakpoints} \label{s:breakpoints}
+\section{s:breakpoints}{Breakpoints}
A breakpoint causes the program to stop whenever a certain point in
the program is reached. It can be set in several ways using the
Set a breakpoint in module \var{module} at the event closest to
character number \var{character}.
-\item["break "\var{address}]
-Set a breakpoint at the code address \var{address}.
+\item["break " \var{frag}":"\var{pc}, "break " \var{pc}]
+Set a breakpoint at code address \var{frag}":"\var{pc}. The integer
+\var{frag} is the identifier of a code fragment, a set of modules that
+have been loaded at once, either initially or with the "Dynlink"
+module. The integer \var{pc} is the instruction counter within this
+code fragment. If \var{frag} is ommited, it defaults to 0, which is
+the code fragment of the program loaded initially.
\item["delete "\optvar{breakpoint-numbers}]
Delete the specified breakpoints. Without argument, all breakpoints
\item["info breakpoints"] Print the list of all breakpoints.
\end{options}
-\section{The call stack}
+\section{s:debugger-callstack}{The call stack}
Each time the program performs a function application, it saves the
location of the application (the return address) in a block of data
says how many frames to go down.
\end{options}
-\section{Examining variable values}
+\section{s:debugger-examining-values}{Examining variable values}
The debugger can print the current value of simple expressions. The
expressions can involve program variables: all the identifiers that
\begin{options}
\item["set print_depth" \var{d}]
-Limit the printing of values to a maximal depth of \var{d}.
+Limit the printing of values to a maximal depth of \var{d}.
\item["set print_length" \var{l}]
Limit the printing of values to at most \var{l} nodes printed.
\end{options}
-\section{Controlling the debugger}
+\section{s:debugger-control}{Controlling the debugger}
-\subsection{Setting the program name and arguments}
+\subsection{ss:debugger-name-and-arguments}{Setting the program name and arguments}
\begin{options}
\item["set program" \var{file}]
input to the debugger are not properly separated, and inputs are not
properly replayed when running the program backwards.
-\subsection{How programs are loaded}
+\subsection{ss:debugger-loading}{How programs are loaded}
The "loadingmode" variable controls how the program is executed.
in ``custom runtime'' mode.
\item["set loadingmode manual"]
The user starts manually the program, when asked by the debugger.
-Allows remote debugging (see section~\ref{s:communication}).
+Allows remote debugging (see section~\ref{ss:debugger-communication}).
\end{options}
-\subsection{Search path for files}
+\subsection{ss:debugger-search-path}{Search path for files}
The debugger searches for source files and compiled interface files in
a list of directories, the search path. The search path initially
Reset the search path. This requires confirmation.
\end{options}
-\subsection{Working directory}
+\subsection{ss:debugger-working-dir}{Working directory}
Each time a program is started in the debugger, it inherits its working
directory from the current working directory of the debugger. This
Print the working directory for "ocamldebug".
\end{options}
-\subsection{Turning reverse execution on and off}
+\subsection{ss:debugger-reverse-execution}{Turning reverse execution on and off}
In some cases, you may want to turn reverse execution off. This speeds
up the program execution, and is also sometimes useful for interactive
Select whether the debugger makes checkpoints or not.
\end{options}
-\subsection{Communication between the debugger and the program}
-\label{s:communication}
+\subsection{ss:debugger-fork}{Behavior of the debugger with respect to "fork"}
+
+When the program issues a call to "fork", the debugger can either
+follow the child or the parent. By default, the debugger follows the
+parent process. The variable \var{follow_fork_mode} controls this
+behavior:
+
+\begin{options}
+\item["set follow_fork_mode" \var{child/parent}]
+Select whether to follow the child or the parent in case of a call to
+"fork".
+\end{options}
+
+\subsection{ss:debugger-stop-at-new-load}{Stopping execution when new code is loaded}
+
+The debugger is compatible with the "Dynlink" module. However, when an
+external module is not yet loaded, it is impossible to set a
+breakpoint in its code. In order to facilitate setting breakpoints in
+dynamically loaded code, the debugger stops the program each time new
+modules are loaded. This behavior can be disabled using the
+\var{break_on_load} variable:
+
+\begin{options}
+\item["set break_on_load" \var{on/off}]
+Select whether to stop after loading new code.
+\end{options}
+
+\subsection{ss:debugger-communication}{Communication between the debugger and the program}
The debugger communicate with the program being debugged through a
Unix socket. You may need to change the socket name, for example if
On the debugged program side, the socket name is passed through the
"CAML_DEBUG_SOCKET" environment variable.
-\subsection{Fine-tuning the debugger} \label{s:fine-tuning}
+\subsection{ss:debugger-fine-tuning}{Fine-tuning the debugger}
Several variables enables to fine-tune the debugger. Reasonable
defaults are provided, and you should normally not have to change them.
Print the list of events in the given module (the current module, by default).
\end{options}
-\subsection{User-defined printers}
+\subsection{ss:debugger-printers}{User-defined printers}
Just as in the toplevel system (section~\ref{s:toplevel-directives}),
the user can register functions for printing values of certain types.
Remove the named function from the table of value printers.
\end{options}
-\section{Miscellaneous commands}
+\section{s:debugger-misc-cmds}{Miscellaneous commands}
\begin{options}
\item["list" \optvar{module} \optvar{beginning} \optvar{end}]
Read debugger commands from the script \var{filename}.
\end{options}
-\section{Running the debugger under Emacs} \label{s:inf-debugger}
+\section{s:inf-debugger}{Running the debugger under Emacs}
The most user-friendly way to use the debugger is to run it under Emacs.
See the file "emacs/README" in the distribution for information on how
\chapter{Optimisation with Flambda}
%HEVEA\cutname{flambda.html}
-\section{Overview}
+\section{s:flambda-overview}{Overview}
{\em Flambda} is the term used to describe a series of optimisation passes
provided by the native code compilers as of OCaml 4.03.
Flambda should not in general affect the semantics of existing programs.
Two exceptions to this rule are: possible elimination of pure code
-that is being benchmarked (see section\ \ref{inhibition}) and changes in
-behaviour of code using unsafe operations (see section\ \ref{unsafe}).
+that is being benchmarked (see section\ \ref{s:flambda-inhibition}) and changes in
+behaviour of code using unsafe operations (see section\ \ref{s:flambda-unsafe}).
Flambda does not yet optimise array or string bounds checks. Neither
does it take hints for optimisation from any assertions written by the
Consult the {\em Glossary} at the end of this chapter for definitions of
technical terms used below.
-\section{Command-line flags}
+\section{s:flambda-cli}{Command-line flags}
The Flambda optimisers provide a variety of command-line flags that may
be used to control their behaviour. Detailed descriptions of each flag
\begin{options}
\item[\machine{-O2}] Perform more optimisation than usual. Compilation
times may be lengthened. (This flag is an abbreviation for a certain
-set of parameters described in section\ \ref{defaults}.)
+set of parameters described in section\ \ref{s:flambda-defaults}.)
\item[\machine{-O3}] Perform even more optimisation than usual, possibly
including unrolling of recursive functions. Compilation times may be
significantly lengthened.
\item[\machine{-remove-unused-arguments}] Remove unused function arguments
even when the argument is not specialised. This may have a small
performance penalty.
-See section\ \ref{remove-unused-args}.
+See section\ \ref{ss:flambda-remove-unused-args}.
\item[\machine{-unbox-closures}] Pass free variables via specialised arguments
rather than closures (an optimisation for reducing allocation). See
-section\ \ref{unbox-closures}. This may have a small performance penalty.
+section\ \ref{ss:flambda-unbox-closures}. This may have a small performance penalty.
\end{options}
Advanced options, only needed for detailed tuning:
\begin{itemize}
\item When not in {\tt -Oclassic} mode, {\tt -inline} limits the total
size of functions considered for inlining during any speculative inlining
-search. (See section\ \ref{speculation}.) Note that
+search. (See section\ \ref{ss:flambda-speculation}.) Note that
this parameter does
{\bf not} control the assessment as to whether any particular function may
be inlined. Raising it to excessive amounts will not necessarily cause
more functions to be inlined.
\item When in {\tt -Oclassic} mode, {\tt -inline} behaves as in
previous versions of the compiler: it is the maximum size of function to
-be considered for inlining. See section\ \ref{classic}.
+be considered for inlining. See section\ \ref{ss:flambda-classic}.
\end{itemize}
\item[\machine{-inline-toplevel}] The equivalent of {\tt -inline} but used
when speculative inlining starts at toplevel. See
-section\ \ref{speculation}.
+section\ \ref{ss:flambda-speculation}.
Not used in {\tt -Oclassic} mode.
\item[\machine{-inline-branch-factor}] Controls how the inliner assesses
whether a code path is likely to be hot or cold. See
-section\ \ref{assessment-inlining}.
+section\ \ref{ss:flambda-assessment-inlining}.
\item[\machine{-inline-alloc-cost},
\machine{-inline-branch-cost},
\machine{-inline-call-cost}] Controls how the inliner assesses the runtime
performance penalties associated with various operations. See
- section\ \ref{assessment-inlining}.
+ section\ \ref{ss:flambda-assessment-inlining}.
\item[\machine{-inline-indirect-cost},
\machine{-inline-prim-cost}] Likewise.
\item[\machine{-inline-lifting-benefit}] Controls inlining of functors
-at toplevel. See section\ \ref{assessment-inlining}.
+at toplevel. See section\ \ref{ss:flambda-assessment-inlining}.
\item[\machine{-inline-max-depth}] The maximum depth of any
-speculative inlining search. See section\ \ref{speculation}.
+speculative inlining search. See section\ \ref{ss:flambda-speculation}.
\item[\machine{-inline-max-unroll}] The maximum depth of any unrolling of
recursive functions during any speculative inlining search.
-See section\ \ref{speculation}.
+See section\ \ref{ss:flambda-speculation}.
\item[\machine{-no-unbox-free-vars-of-closures}] %
-Do not unbox closure variables. See section\ \ref{unbox-fvs}.
+Do not unbox closure variables. See section\ \ref{ss:flambda-unbox-fvs}.
\item[\machine{-no-unbox-specialised-args}] %
Do not unbox arguments to which functions have been specialised. See
-section\ \ref{unbox-spec-args}.
+section\ \ref{ss:flambda-unbox-spec-args}.
\item[\machine{-rounds}] How many rounds of optimisation to perform.
-See section\ \ref{rounds}.
+See section\ \ref{ss:flambda-rounds}.
\item[\machine{-unbox-closures-factor}] Scaling factor for benefit
calculation when using {\tt -unbox-closures}. See
-section\ \ref{unbox-closures}.
+section\ \ref{ss:flambda-unbox-closures}.
\end{options}
\paragraph{Notes}
releases.
\end{itemize}
-\subsection{Specification of optimisation parameters by round}\label{rounds}
+\subsection{ss:flambda-rounds}{Specification of optimisation parameters by round}
Flambda operates in {\em rounds}: one round consists of a certain sequence
of transformations that may then be repeated in order to achieve more
having to specify every parameter usually invoked by the given optimisation
level.
-\section{Inlining}
+\section{s:flambda-inlining}{Inlining}
{\em Inlining} refers to the copying of the code of a function to a
place where the function is called.
Flambda provides significantly enhanced inlining capabilities relative to
previous versions of the compiler.
-\subsubsection{Aside: when inlining is performed}
+\subsubsection{sss:flambda-inlining-aside}{Aside: when inlining is performed}
Inlining is performed together with all of the other Flambda optimisation
passes, that is to say, after closure conversion. This has three particular
in which closures, helping to avoid closure bloat.
\end{itemize}
-\subsection{Classic inlining heuristic}\label{classic}
+\subsection{ss:flambda-classic}{Classic inlining heuristic}
In {\tt -Oclassic} mode the behaviour of the Flambda inliner
mimics previous versions
of the compiler. (Code may still be subject to further optimisations not
performed by previous versions of the compiler: functors may be inlined,
constants are lifted and unused code is eliminated all as described elsewhere
-in this chapter. See sections \ref{functors},\ \ref{lift-const} %
-and\ \ref{remove-unused}.
+in this chapter. See sections \ref{sss:flambda-functors},\ \ref{ss:flambda-lift-const} %
+and\ \ref{s:flambda-remove-unused}.
At the definition site of a function, the body of the
function is measured. It will then be marked as eligible for inlining
(and hence inlined at every direct call site) if:
\end{itemize}
The Flambda mode is described in the next section.
-\subsection{Overview of ``Flambda'' inlining heuristics}
+\subsection{ss:flambda-inlining-overview}{Overview of ``Flambda'' inlining heuristics}
The Flambda inlining heuristics, used whenever the compiler is configured
for Flambda and {\tt -Oclassic} was not specified, make inlining decisions
{\tt -inline-max-unroll}
flag is passed with an argument greater than zero.)
-\subsection{Handling of specific language constructs}
+\subsection{ss:flambda-by-constructs}{Handling of specific language constructs}
-\subsubsection{Functors}\label{functors}
+\subsubsection{sss:flambda-functors}{Functors}
There is nothing particular about functors that inhibits inlining compared
to normal functions. To the inliner, these both look the same, except
inside some other expression, are treated by the inliner identically to
normal function calls.
-\subsubsection{First-class modules}
+\subsubsection{sss:flambda-first-class-modules}{First-class modules}
The inliner will be able to consider inlining a call to a function in a first
class module if it knows which particular function is going to be called.
The presence of the first-class module record that wraps the set of functions
in the module does not per se inhibit inlining.
-\subsubsection{Objects}
+\subsubsection{sss:flambda-objects}{Objects}
Method calls to objects are not at present inlined by Flambda.
-\subsection{Inlining reports}
+\subsection{ss:flambda-inlining-reports}{Inlining reports}
If the {\tt -inlining-report} option is provided to the compiler then a file
will be emitted corresponding to each round of optimisation. For the
zero-based integer. Inside the files, which are formatted as ``org mode'',
will be found English prose describing the decisions that the inliner took.
-\subsection{Assessment of inlining benefit}\label{assessment-inlining}
+\subsection{ss:flambda-assessment-inlining}{Assessment of inlining benefit}
Inlining typically
results in an increase in code size, which if left unchecked, may not only
using the various {\tt -inline-...-cost} flags as follows. Costs are
specified as integers. All of these flags accept a single argument
describing such integers using the conventions
-detailed in section\ \ref{rounds}.
+detailed in section\ \ref{ss:flambda-rounds}.
\begin{options}
\item[\machine{-inline-alloc-cost}] The cost of an allocation.
\item[\machine{-inline-branch-cost}] The cost of a branch.
\item[\machine{-inline-prim-cost}] The cost of a {\em primitive}. Primitives
encompass operations including arithmetic and memory access.
\end{options}
-(Default values are described in section\ \ref{defaults} below.)
+(Default values are described in section\ \ref{s:flambda-defaults} below.)
The initial benefit value is then scaled by a factor that attempts to
compensate for the fact that the current point in the code, if under some
{\tt -inline-lifting-benefit} flag) to bias inlining in such situations
towards keeping the inlined version.
-\subsection{Control of speculation}\label{speculation}
+\subsection{ss:flambda-speculation}{Control of speculation}
As described above, there are three parameters that restrict the search
for inlining opportunities during speculation:
depth reaches the limit set by {\tt -inline-max-unroll} then speculation
stops.
-\section{Specialisation}\label{specialisation}
+\section{s:flambda-specialisation}{Specialisation}
The inliner may discover a call site to a recursive function where
something is known about the arguments: for example, they may be equal to
iter_swap f g t
\end{verbatim}
-\subsection{Assessment of specialisation benefit}
+\subsection{ss:flambda-assessment-specialisation}{Assessment of specialisation benefit}
The benefit of specialisation is assessed in a similar way as for inlining.
Specialised argument information may mean that the body of the function
function declaration, is then assessed against the size of the call to the
original function.
-\section{Default settings of parameters}\label{defaults}
+\section{s:flambda-defaults}{Default settings of parameters}
The default settings (when not using {\tt -Oclassic}) are for one
round of optimisation using the following parameters.
\entree{{\tt -unbox-closures-factor}}{10}
\end{tableau}
-\subsection{Settings at -O2 optimisation level}
+\subsection{ss:flambda-o2}{Settings at -O2 optimisation level}
When {\tt -O2} is specified two rounds of optimisation are performed.
The first round uses the default parameters (see above). The second uses
\entree{{\tt -unbox-closures-factor}}{Same as default}
\end{tableau}
-\subsection{Settings at -O3 optimisation level}
+\subsection{ss:flambda-o3}{Settings at -O3 optimisation level}
When {\tt -O3} is specified three rounds of optimisation are performed.
The first two rounds are as for {\tt -O2}. The third round uses
\entree{{\tt -unbox-closures-factor}}{Same as default}
\end{tableau}
-\section{Manual control of inlining and specialisation}
+\section{s:flambda-manual-control}{Manual control of inlining and specialisation}
Should the inliner prove recalcitrant and refuse to inline a particular
function, or if the observed inlining decisions are not to the programmer's
module X = F [@inlined] (struct type t = int end)
\end{verbatim}
-\section{Simplification}
+\section{s:flambda-simplification}{Simplification}
Simplification, which is run in conjunction with inlining,
propagates information (known as {\em approximations}) about which
even in {\tt safe-string} mode, because it cannot yet be guaranteed
that they are immutable throughout a given program.
-\section{Other code motion transformations}
+\section{s:flambda-other-transfs}{Other code motion transformations}
-\subsection{Lifting of constants}\label{lift-const}
+\subsection{ss:flambda-lift-const}{Lifting of constants}
Expressions found to be constant will be lifted to symbol
bindings---that is to say, they will be statically allocated in the
\end{itemize}
\end{itemize}
-\subsection{Lifting of toplevel let bindings}
+\subsection{ss:flambda-lift-toplevel-let}{Lifting of toplevel let bindings}
Toplevel {\tt let}-expressions may be lifted to symbol bindings to ensure
that the corresponding bound variables are not captured by closures. If the
as to never be inlined. This technique prevents lifting of the definition
of the value in question (assuming of course that it is not constant).
-\section{Unboxing transformations}
+\section{s:flambda-unboxing}{Unboxing transformations}
The transformations in this section relate to the splitting apart of
{\em boxed} (that is to say, non-immediate) values. They are largely
intended to reduce allocation, which tends to result in a runtime
performance profile with lower variance and smaller tails.
-\subsection{Unboxing of closure variables}\label{unbox-fvs}
+\subsection{ss:flambda-unbox-fvs}{Unboxing of closure variables}
This transformation is enabled unless
{\tt -no-unbox-free-vars-of-closures} is provided.
This transformation does not operate if it would cause the closure to
contain more than twice as many closure variables as it did beforehand.
-\subsection{Unboxing of specialised arguments}\label{unbox-spec-args}
+\subsection{ss:flambda-unbox-spec-args}{Unboxing of specialised arguments}
This transformation is enabled unless
{\tt -no-unbox-specialised-args} is provided.
of {\em direct call surrogates} used for {\tt -unbox-closures} is not
used by the transformation to unbox specialised arguments.)
-\subsection{Unboxing of closures}\label{unbox-closures}
+\subsection{ss:flambda-unbox-closures}{Unboxing of closures}
This transformation is {\em not} enabled by default. It may be enabled
using the {\tt -unbox-closures} flag.
order to eliminate all closure allocation in this example (aside from any
that might be performed inside {\tt printf}).
-\section{Removal of unused code and values}\label{remove-unused}
+\section{s:flambda-remove-unused}{Removal of unused code and values}
-\subsection{Removal of redundant let expressions}
+\subsection{ss:flambda-redundant-let}{Removal of redundant let expressions}
The simplification pass removes unused {\tt let} bindings so long as
their corresponding defining expressions have ``no effects''. See
the section ``Treatment of effects'' below for the precise definition of
this term.
-\subsection{Removal of redundant program constructs}
+\subsection{ss:flambda-redundant}{Removal of redundant program constructs}
This transformation is analogous to the removal of {\tt let}-expressions
whose defining expressions have no effects. It operates instead on symbol
bindings, removing those that have no effects.
-\subsection{Removal of unused arguments}\label{remove-unused-args}
+\subsection{ss:flambda-remove-unused-args}{Removal of unused arguments}
This transformation is only enabled by default for specialised arguments.
It may be enabled for all arguments using the {\tt -remove-unused-arguments}
to reduce this penalty during unboxing of closure variables (see above)
does not yet apply to the pass that removes unused arguments.)
-\subsection{Removal of unused closure variables}
+\subsection{ss:flambda-removal-closure-vars}{Removal of unused closure variables}
This transformation performs an analysis across
the whole compilation unit to determine whether there exist closure variables
variable from some particular closure may have propagated to an arbitrary
location within the code due to inlining.)
-\section{Other code transformations}
+\section{s:flambda-other}{Other code transformations}
-\subsection{Transformation of non-escaping references into mutable variables}
+\subsection{ss:flambda-non-escaping-refs}{Transformation of non-escaping references into mutable variables}
Flambda performs a simple analysis analogous to that performed elsewhere
in the compiler that can transform {\tt ref}s into mutable variables
than being allocated on the OCaml heap. This only happens so long as the
reference concerned can be shown to not escape from its defining scope.
-\subsection{Substitution of closure variables for specialised arguments}
+\subsection{ss:flambda-subst-closure-vars}{Substitution of closure variables for specialised arguments}
This transformation discovers closure variables that are known to be
equal to specialised arguments. Such closure variables are replaced by
the specialised arguments; the closure variables may then be removed by
the ``removal of unused closure variables'' pass (see below).
-\section{Treatment of effects}
+\section{s:flambda-effects}{Treatment of effects}
The Flambda optimisers classify expressions in order to determine whether
an expression:
expressions with neither effects nor coeffects may be reordered with
respect to other expressions.
-\section{Compilation of statically-allocated modules}
+\section{s:flambda-static-modules}{Compilation of statically-allocated modules}
Compilation of modules that are able to be statically allocated (for example,
the module corresponding to an entire compilation unit, as opposed to a first
the module block. The Flambda-specific transformation follows: these bindings
are lifted to toplevel symbols, as described above.
-\section{Inhibition of optimisation}\label{inhibition}
+\section{s:flambda-inhibition}{Inhibition of optimisation}
Especially when writing benchmarking suites that run non-side-effecting
algorithms in loops, it may be found that the optimiser entirely
normal OCaml function and does not possess any ``magic'' semantics). The
documentation of the {\tt Sys} module should be consulted for further details.
-\section{Use of unsafe operations}\label{unsafe}
+\section{s:flambda-unsafe}{Use of unsafe operations}
The behaviour of the Flambda simplification pass means that certain unsafe
operations, which may without Flambda or when using previous versions of
if it might be possible for an unsafe operation to update it to a boxed
value.
-\section{Glossary}
+\section{s:flambda-glossary}{Glossary}
The following terminology is used in this chapter of the manual.
\item[{\bf Specialised argument}] An argument to a function that is known
to always hold a particular value at runtime. These are introduced by the
inliner when specialising recursive functions; and the {\tt unbox-closures}
-pass. (See section\ \ref{specialisation}.)
+pass. (See section\ \ref{s:flambda-specialisation}.)
\item[{\bf Symbol}] A name referencing a particular place in an object file
or executable image. At that particular place will be some constant value.
Symbols may be examined using operating system-specific tools (for
be linked with OCaml code and called from OCaml functions, and how
these C functions can call back to OCaml code.
-\section{Overview and compilation information}
+\section{s:c-overview}{Overview and compilation information}
-\subsection{Declaring primitives}
+\subsection{ss:c-prim-decl}{Declaring primitives}
\begin{syntax}
definition: ...
flag strings in addition to the C function's name. These flags are
reserved for the implementation of the standard library.
-\subsection{Implementing primitives}
+\subsection{ss:c-prim-impl}{Implementing primitives}
User primitives with arity $n \leq 5$ are implemented by C functions
that take $n$ arguments of type "value", and return a result of type
\entree{"caml/memory.h"}{miscellaneous memory-related functions
and macros (for GC interface, in-place modification of structures, etc).}
\entree{"caml/fail.h"}{functions for raising exceptions
-(see section~\ref{s:c-exceptions})}
+(see section~\ref{ss:c-exceptions})}
\entree{"caml/callback.h"}{callback from C to OCaml (see
-section~\ref{s:callback}).}
+section~\ref{s:c-callback}).}
\entree{"caml/custom.h"}{operations on custom blocks (see
-section~\ref{s:custom}).}
+section~\ref{s:c-custom}).}
\entree{"caml/intext.h"}{operations for writing user-defined
serialization and deserialization functions for custom blocks
-(see section~\ref{s:custom}).}
+(see section~\ref{s:c-custom}).}
\entree{"caml/threads.h"}{operations for interfacing in the presence
of multiple threads (see section~\ref{s:C-multithreading}).}
\end{tableau}
+Before including any of these files, you should define the "OCAML_NAME_SPACE"
+macro. For instance,
+\begin{verbatim}
+#define CAML_NAME_SPACE
+#include "caml/mlvalues.h"
+#include "caml/fail.h"
+\end{verbatim}
These files reside in the "caml/" subdirectory of the OCaml
standard library directory, which is returned by the command
"ocamlc -where" (usually "/usr/local/lib/ocaml" or "/usr/lib/ocaml").
-By default, header files in the "caml/" subdirectory give only access
-to the public interface of the OCaml runtime. It is possible to define
-the macro "CAML_INTERNALS" to get access to a lower-level interface,
-but this lower-level interface is more likely to change and break
-programs that use it.
+{\bf Note:}
+Including the header files without first defining "CAML_NAME_SPACE"
+introduces in scope short names for most functions.
+Those short names are deprecated, and may be removed in the future
+because they usually produce clashes with names defined by other
+C libraries.
-{\bf Note:} It is recommended to define the macro "CAML_NAME_SPACE"
-before including these header files. If you do not define it, the
-header files will also define short names (without the "caml_" prefix)
-for most functions, which usually produce clashes with names defined
-by other C libraries that you might use. Including the header files
-without "CAML_NAME_SPACE" is only supported for backward
-compatibility.
-
-\subsection{Statically linking C code with OCaml code}
-\label{staticlink-c-code}
+\subsection{ss:staticlink-c-code}{Statically linking C code with OCaml code}
The OCaml runtime system comprises three main parts: the bytecode
interpreter, the memory manager, and a set of C functions that
standard runtime system, with a standard set of primitives. References
to primitives that are not in this standard set result in the
``unavailable C primitive'' error. (Unless dynamic loading of C
-libraries is supported -- see section~\ref{dynlink-c-code} below.)
+libraries is supported -- see section~\ref{ss:dynlink-c-code} below.)
In the ``custom runtime'' mode, the OCaml linker scans the
object files and determines the set of required primitives. Then, it
The former alternative is more convenient for the final users of the
library, however.
-\subsection{Dynamically linking C code with OCaml code}
-\label{dynlink-c-code}
+\subsection{ss:dynlink-c-code}{Dynamically linking C code with OCaml code}
Starting with Objective Caml 3.03, an alternative to static linking of C code
using the "-custom" code is provided. In this mode, the OCaml linker
shared library from the resulting object files. The resulting shared
library or DLL file must be installed in a place where "ocamlrun" can
find it later at program start-up time (see
-section~\ref{s-ocamlrun-dllpath}).
+section~\ref{s:ocamlrun-dllpath}).
Finally (step 3), execute the "ocamlc" command with
\begin{itemize}
\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
"-dllib -l"\var{name}.
\end{itemize}
Do {\em not} set the "-custom" flag, otherwise you're back to static linking
-as described in section~\ref{staticlink-c-code}.
-The "ocamlmklib" tool (see section~\ref{s-ocamlmklib})
+as described in section~\ref{ss:staticlink-c-code}.
+The "ocamlmklib" tool (see section~\ref{s:ocamlmklib})
automates steps 2 and 3.
As in the case of static linking, it is possible (and recommended) to
known that it references C code, nor whether this C code must be
statically linked (using "-custom") or dynamically linked.
-\subsection{Choosing between static linking and dynamic linking}
+\subsection{ss:c-static-vs-dynamic}{Choosing between static linking and dynamic linking}
After having described two different ways of linking C code with OCaml
code, we now review the pros and cons of each, to help developers of
wildly between different Unix systems. Also, dynamic linking is not
supported on all Unix systems, requiring a fall-back case to static
linking in the Makefile for the library. The "ocamlmklib" command
-(see section~\ref{s-ocamlmklib}) tries to hide some of these system
+(see section~\ref{s:ocamlmklib}) tries to hide some of these system
dependencies.
In conclusion: dynamic linking is highly recommended under the native
rarely-used libraries, static linking is much simpler to set up in a
portable way.
-\subsection{Building standalone custom runtime systems}
-\label{s:custom-runtime}
+\subsection{ss:custom-runtime}{Building standalone custom runtime systems}
It is sometimes inconvenient to build a custom runtime system each
time OCaml code is linked with C libraries, like "ocamlc -custom" does.
bytecode executable (so that the bytecode from "unix.cma" and
"threads.cma" is actually linked in).
-\section{The \texttt{value} type}
+\section{s:c-value}{The \texttt{value} type}
All OCaml objects are represented by the C type "value",
defined in the include file "caml/mlvalues.h", along with macros to
%%% FIXME will change in 4.02.0 (?)
\end{itemize}
-\subsection{Integer values}
+\subsection{ss:c-int}{Integer values}
Integer values encode 63-bit signed integers (31-bit on 32-bit
architectures). They are unboxed (unallocated).
-\subsection{Blocks}
+\subsection{ss:c-blocks}{Blocks}
Blocks in the heap are garbage-collected, and therefore have strict
structure constraints. Each block includes a header containing the
serialization and deserialization functions attached.}
\end{tableau}
-\subsection{Pointers outside the heap}
+\subsection{ss:c-outside-head}{Pointers outside the heap}
Any word-aligned pointer to an address outside the heap can be safely
cast to and from the type "value". This includes pointers returned by
these problems, it is preferable to wrap the pointer in a OCaml block
with tag "Abstract_tag" or "Custom_tag".
-\section{Representation of OCaml data types}
+\section{s:c-ocaml-datatype-repr}{Representation of OCaml data types}
This section describes how OCaml data types are encoded in the
"value" type.
-\subsection{Atomic types}
+\subsection{ss:c-atomic}{Atomic types}
\begin{tableau}{|l|l|}{OCaml type}{Encoding}
\entree{"int"}{Unboxed integer values.}
\entree{"nativeint"}{Blocks with tag "Custom_tag".}
\end{tableau}
-\subsection{Tuples and records}
-\label{ss:tuples-and-records}
+\subsection{ss:c-tuples-and-records}{Tuples and records}
Tuples are represented by pointers to blocks, with tag~0.
default is the boxed representation.
\end{itemize}
-\subsection{Arrays}
+\subsection{ss:c-arrays}{Arrays}
Arrays of integers and pointers are represented like tuples,
that is, as pointers to blocks tagged~0. They are accessed with the
"Double_array_tag". They should be accessed with the "Double_field"
and "Store_double_field" macros.
-\subsection{Concrete data types}
+\subsection{ss:c-concrete-datatypes}{Concrete data types}
Constructed terms are represented either by unboxed integers (for
constant constructors) or by blocks whose tag encode the constructor
constructor and this constructor has exactly one argument. Unboxable
concrete data types are represented in the same ways as unboxable
record types: see the description in
-section~\ref{ss:tuples-and-records}.
+section~\ref{ss:c-tuples-and-records}.
-\subsection{Objects}
+\subsection{ss:c-objects}{Objects}
Objects are represented as blocks with tag "Object_tag". The first
field of the block refers to the object's class and associated method
callback(caml_get_public_method(foo, hash_variant("bar")), foo);
\end{verbatim}
-\subsection{Polymorphic variants}
+\subsection{ss:c-polyvar}{Polymorphic variants}
Like constructed terms, polymorphic variant values are represented either
as integers (for polymorphic variants without argument), or as blocks
pair "("\var{v}", "\var{w}")", rather than a block of size 3
containing \var{v} and \var{w} in fields 1 and 2.
-\section{Operations on values}
+\section{s:c-ops-on-values}{Operations on values}
-\subsection{Kind tests}
+\subsection{ss:c-kind-tests}{Kind tests}
\begin{itemize}
\item "Is_long("\var{v}")" is true if value \var{v} is an immediate integer,
and false if it is an immediate integer.
\end{itemize}
-\subsection{Operations on integers}
+\subsection{ss:c-int-ops}{Operations on integers}
\begin{itemize}
\item "Val_long("\var{l}")" returns the value encoding the "long int" \var{l}.
\item "Val_true", "Val_false" represent the OCaml booleans "true" and "false".
\end{itemize}
-\subsection{Accessing blocks}
+\subsection{ss:c-block-access}{Accessing blocks}
\begin{itemize}
\item "Wosize_val("\var{v}")" returns the size of the block \var{v}, in words,
be done with care to avoid confusing the garbage collector (see
below).
-\subsection{Allocating blocks}
+\subsection{ss:c-block-allocation}{Allocating blocks}
-\subsubsection{Simple interface}
+\subsubsection{sss:c-simple-allocation}{Simple interface}
\begin{itemize}
\item
representation of unboxable types in the current version of OCaml.
\end{itemize}
-\subsubsection{Low-level interface}
+\subsubsection{sss:c-low-level-alloc}{Low-level interface}
The following functions are slightly more efficient than "caml_alloc", but
also much more difficult to use.
before the next allocation.
\end{itemize}
-\subsection{Raising exceptions} \label{s:c-exceptions}
+\subsection{ss:c-exceptions}{Raising exceptions}
Two functions are provided to raise two standard exceptions:
\begin{itemize}
Raising arbitrary exceptions from C is more delicate: the
exception identifier is dynamically allocated by the OCaml program, and
therefore must be communicated to the C function using the
-registration facility described below in section~\ref{s:register-exn}.
+registration facility described below in section~\ref{ss:c-register-exn}.
Once the exception identifier is recovered in C, the following
functions actually raise the exception:
\begin{itemize}
the C string \var{s} as argument.
\end{itemize}
-\section{Living in harmony with the garbage collector}
+\section{s:c-gc-harmony}{Living in harmony with the garbage collector}
Unused blocks in the heap are automatically reclaimed by the garbage
collector. This requires some cooperation from C code that
manipulates heap-allocated blocks.
-\subsection{Simple interface}
+\subsection{ss:c-simple-gc-harmony}{Simple interface}
All the macros described in this section are declared in the
"memory.h" header file.
Use the normal C array syntax instead.
\begin{gcrule} Global variables containing values must be registered
-with the garbage collector using the "caml_register_global_root" function.
+with the garbage collector using the "caml_register_global_root" function,
+save that global variables and locations that will only ever contain OCaml
+integers (and never pointers) do not have to be registered.
+
+The same is true for any memory location outside the OCaml heap that contains a
+value and is not guaranteed to be reachable---for as long as it contains such
+value---from either another registered global variable or location, local
+variable declared with "CAMLlocal" or function parameter declared with
+"CAMLparam".
\end{gcrule}
Registration of a global variable "v" is achieved by calling
-"caml_register_global_root(&v)" just before or just after a valid
-value is stored in "v" for the first time. You must not call any
-of the OCaml runtime functions or macros between registering and
-storing the value.
+"caml_register_global_root(&v)" just before or just after a valid value is
+stored in "v" for the first time; likewise, registration of an arbitrary
+location "p" is achieved by calling "caml_register_global_root(p)".
+
+You must not call any of the OCaml runtime functions or macros between
+registering and storing the value. Neither must you store anything in the
+variable "v" (likewise, the location "p") that is not a valid value.
+
+The registration causes the contents of the variable or memory location to be
+updated by the garbage collector whenever the value in such variable or location
+is moved within the OCaml heap. In the presence of threads care must be taken to
+ensure appropriate synchronisation with the OCaml runtime to avoid a race
+condition against the garbage collector when reading or writing the value. (See
+section
+\ref{ss:parallel-execution-long-running-c-code}.)
A registered global variable "v" can be un-registered by calling
"caml_remove_global_root(&v)".
identifiers, structure tags) that start with "caml__". Do not use any
identifier starting with "caml__" in your programs.
-\subsection{Low-level interface}
+\subsection{ss:c-low-level-gc-harmony}{Low-level interface}
% Il faudrait simplifier violemment ce qui suit.
% En gros, dire quand on n'a pas besoin de declarer les variables
has taken place since "r" was allocated.
-\section{A complete example}
+\subsection{ss:c-process-pending-actions}{Pending actions and asynchronous exceptions}
+
+Since 4.10, allocation functions are guaranteed not to call any OCaml
+callbacks from C, including finalisers and signal handlers, and delay
+their execution instead.
+
+The function \verb"caml_process_pending_actions" from
+"<caml/signals.h>" executes any pending signal handlers and
+finalisers, Memprof callbacks, and requested minor and major garbage
+collections. In particular, it can raise asynchronous exceptions. It
+is recommended to call it regularly at safe points inside long-running
+non-blocking C code.
+
+The variant \verb"caml_process_pending_actions_exn" is provided, that
+returns the exception instead of raising it directly into OCaml code.
+Its result must be tested using {\tt Is_exception_result}, and
+followed by {\tt Extract_exception} if appropriate. It is typically
+used for clean up before re-raising:
+
+\begin{verbatim}
+ CAMLlocal1(exn);
+ ...
+ exn = caml_process_pending_actions_exn();
+ if(Is_exception_result(exn)) {
+ exn = Extract_exception(exn);
+ ...cleanup...
+ caml_raise(exn);
+ }
+\end{verbatim}
+
+Correct use of exceptional return, in particular in the presence of
+garbage collection, is further detailed in Section~\ref{ss:c-callbacks}.
+
+\section{s:c-intf-example}{A complete example}
This section outlines how the functions from the Unix "curses" library
can be made available to OCaml programs. First of all, here is
\begin{verbatim}
/* File curses_stubs.c -- stub code for curses */
#include <curses.h>
+#define CAML_NAME_SPACE
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
/* Allocating an OCaml custom block to hold the given WINDOW * */
static value alloc_window(WINDOW * w)
{
- value v = alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1);
+ value v = caml_alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1);
Window_val(v) = w;
return v;
}
%% Note by Damien: when I launch the program, it only displays "Hello"
%% and not "world". Why?
-\section{Advanced topic: callbacks from C to OCaml} \label{s:callback}
+\section{s:c-callback}{Advanced topic: callbacks from C to OCaml}
So far, we have described how to call C functions from OCaml. In this
section, we show how C functions can call OCaml functions, either as
callbacks (OCaml calls C which calls OCaml), or with the main program
written in C.
-\subsection{Applying OCaml closures from C} \label{s:callbacks}
+\subsection{ss:c-callbacks}{Applying OCaml closures from C}
C functions can apply OCaml function values (closures) to OCaml values.
The following functions are provided to perform the applications:
}
\end{verbatim}
-\subsection{Obtaining or registering OCaml closures for use in C functions}
+\subsection{ss:c-closures}{Obtaining or registering OCaml closures for use in C functions}
There are two ways to obtain OCaml function values (closures) to
be passed to the "callback" functions described above. One way is to
}
\end{verbatim}
-\subsection{Registering OCaml exceptions for use in C functions} \label{s:register-exn}
+\subsection{ss:c-register-exn}{Registering OCaml exceptions for use in C functions}
The registration mechanism described above can also be used to
communicate exception identifiers from OCaml to C. The OCaml code
The C code can then recover the exception identifier using
"caml_named_value" and pass it as first argument to the functions
"raise_constant", "raise_with_arg", and "raise_with_string" (described
-in section~\ref{s:c-exceptions}) to actually raise the exception. For
+in section~\ref{ss:c-exceptions}) to actually raise the exception. For
example, here is a C function that raises the "Error" exception with
the given argument:
\begin{verbatim}
}
\end{verbatim}
-\subsection{Main program in C} \label{s:main-c}
+\subsection{ss:main-c}{Main program in C}
In normal operation, a mixed OCaml/C program starts by executing the
OCaml initialization code, which then may proceed to call C
C code that called "caml_main".
\item The C code can then invoke OCaml functions using the callback
-mechanism (see section~\ref{s:callbacks}).
+mechanism (see section~\ref{ss:c-callbacks}).
\end{itemize}
-\subsection{Embedding the OCaml code in the C code} \label{s:embedded-code}
+\subsection{ss:c-embedded-code}{Embedding the OCaml code in the C code}
The bytecode compiler in custom runtime mode ("ocamlc -custom")
normally appends the bytecode to the executable file containing the
step must be performed by "ocamlc". Second, the OCaml runtime library
must be able to find the name of the executable file from the
command-line arguments. When using "caml_main(argv)" as in
-section~\ref{s:main-c}, this means that "argv[0]" or "argv[1]" must
+section~\ref{ss:main-c}, this means that "argv[0]" or "argv[1]" must
contain the executable file name.
An alternative is to embed the bytecode in the C code. The
\begin{itemize}
\item Running the functions that were registered with "Stdlib.at_exit".
\item Triggering finalization of allocated custom blocks (see
-section~\ref{s:custom}). For example, "Stdlib.in_channel" and
+section~\ref{s:c-custom}). For example, "Stdlib.in_channel" and
"Stdlib.out_channel" are represented by custom blocks that enclose file
descriptors, which are to be released.
\item Unloading the dependent shared libraries that were loaded by the runtime,
facility is only useful for building reloadable shared libraries.
-\section{Advanced example with callbacks}
+\section{s:c-advexample}{Advanced example with callbacks}
This section illustrates the callback facilities described in
-section~\ref{s:callback}. We are going to package some OCaml functions
+section~\ref{s:c-callback}. We are going to package some OCaml functions
in such a way that they can be linked with C code and called from C
just like any C functions. The OCaml functions are defined in the
following "mod.ml" OCaml source:
(On some machines, you may need to put "-ltermcap" or
"-lcurses -ltermcap" instead of "-lcurses".)
-\section{Advanced topic: custom blocks} \label{s:custom}
+\section{s:c-custom}{Advanced topic: custom blocks}
Blocks with tag "Custom_tag" contain both arbitrary user data and a
pointer to a C struct, with type "struct custom_operations", that
associates user-provided finalization, comparison, hashing,
serialization and deserialization functions to this block.
-\subsection{The "struct custom_operations"}
+\subsection{ss:c-custom-ops}{The "struct custom_operations"}
The "struct custom_operations" is defined in "<caml/custom.h>" and
contains the following fields:
using "register_custom_operations" (see below).
\item "const struct custom_fixed_length* fixed_length" \\
+(Since 4.08.0)
Normally, space in the serialized output is reserved to write the
"bsize_32" and "bsize_64" fields returned by "serialize". However, for
very short custom blocks, this space can be larger than the data
code. Do not use "CAMLparam" to register the parameters to these
functions, and do not use "CAMLreturn" to return the result.
-\subsection{Allocating custom blocks}
+\subsection{ss:c-custom-alloc}{Allocating custom blocks}
Custom blocks must be allocated via "caml_alloc_custom" or
"caml_alloc_custom_mem":
"custom_minor_ratio", and "custom_minor_max_size" parameters) and
proportional to the heap sizes.
-\subsection{Accessing custom blocks}
+\subsection{ss:c-custom-access}{Accessing custom blocks}
The data part of a custom block \var{v} can be
accessed via the pointer "Data_custom_val("\var{v}")". This pointer
part of a custom block. Conversely, any C data structure (not
containing heap pointers) can be stored in a custom block.
-\subsection{Writing custom serialization and deserialization functions}
+\subsection{ss:c-custom-serialization}{Writing custom serialization and deserialization functions}
The following functions, defined in "<caml/intext.h>", are provided to
write and read back the contents of custom blocks in a portable way.
"struct custom_operation" blocks for one with the same identifier, and
calling its "deserialize" function to fill the data part of the custom block.
-\subsection{Choosing identifiers}
+\subsection{ss:c-custom-idents}{Choosing identifiers}
Identifiers in "struct custom_operations" must be chosen carefully,
since they must identify uniquely the data structure for serialization
("com.mydomain.mymachine.mylibrary.version-number")
as identifiers, to minimize the risk of identifier collision.
-\subsection{Finalized blocks}
+\subsection{ss:c-finalized}{Finalized blocks}
Custom blocks generalize the finalized blocks that were present in
OCaml prior to version 3.00. For backward compatibility, the
\var{used} and \var{max} are used to control the speed of garbage
collection, as described for "caml_alloc_custom".
-\section{Advanced topic: Bigarrays and the OCaml-C interface}
-\label{s:C-Bigarrays}
+\section{s:C-Bigarrays}{Advanced topic: Bigarrays and the OCaml-C interface}
This section explains how C stub code that interfaces C or Fortran
code with OCaml code can use Bigarrays.
-\subsection{Include file}
+\subsection{ss:C-Bigarrays-include}{Include file}
The include file "<caml/bigarray.h>" must be included in the C stub
file. It declares the functions, constants and macros discussed
below.
-\subsection{Accessing an OCaml bigarray from C or Fortran}
+\subsection{ss:C-Bigarrays-access}{Accessing an OCaml bigarray from C or Fortran}
If \var{v} is a OCaml "value" representing a Bigarray, the expression
"Caml_ba_data_val("\var{v}")" returns a pointer to the data part of the array.
}
\end{verbatim}
-\subsection{Wrapping a C or Fortran array as an OCaml Bigarray}
+\subsection{ss:C-Bigarrays-wrap}{Wrapping a C or Fortran array as an OCaml Bigarray}
A pointer \var{p} to an already-allocated C or Fortran array can be
wrapped and returned to OCaml as a Bigarray using the "caml_ba_alloc"
}
\end{verbatim}
-\section{Advanced topic: cheaper C call}
-\label{s:C-cheaper-call}
+\section{s:C-cheaper-call}{Advanced topic: cheaper C call}
This section describe how to make calling C functions cheaper.
use any of these methods, you have to provide an alternative byte-code
stub that ignores all the special annotations.
-\subsection{Passing unboxed values}
+\subsection{ss:c-unboxed}{Passing unboxed values}
We said earlier that all OCaml objects are represented by the C type
"value", and one has to use macros such as "Int_val" to decode data from
{\bf Note:} do not use the C "int" type in correspondence with "(int
[\@untagged])". This is because they often differ in size.
-\subsection{Direct C call}
+\subsection{ss:c-direct-call}{Direct C call}
In order to be able to run the garbage collector in the middle of
a C function, the OCaml native-code compiler generates some bookkeeping
For small functions that are called repeatedly, this indirection can have
a big impact on performances. However this is not needed if we know that
-the C function doesn't allocate and doesn't raise exceptions. We can
-instruct the OCaml native-code compiler of this fact by annotating the
+the C function doesn't allocate, doesn't raise exceptions, and doesn't release
+the master lock (see section~\ref{ss:parallel-execution-long-running-c-code}).
+We can instruct the OCaml native-code compiler of this fact by annotating the
external declaration with the attribute "[\@\@noalloc]":
\begin{verbatim}
OCaml function, except for the fact that the OCaml compiler can't
inline C functions...
-\subsection{Example: calling C library functions without indirection}
+\subsection{ss:c-direct-call-example}{Example: calling C library functions without indirection}
Using these attributes, it is possible to call C library functions
with no indirection. For instance many math functions are defined this
(** Natural logarithm. *)
\end{verbatim}
-\section{Advanced topic: multithreading}
-\label{s:C-multithreading}
+\section{s:C-multithreading}{Advanced topic: multithreading}
Using multiple threads (shared-memory concurrency) in a mixed OCaml/C
application requires special precautions, which are described in this
section.
-\subsection{Registering threads created from C}
+\subsection{ss:c-thread-register}{Registering threads created from C}
Callbacks from C to OCaml are possible only if the calling thread is
known to the OCaml run-time system. Threads created from OCaml (through
previously registered, does nothing and returns 0.
\end{itemize}
-\subsection{Parallel execution of long-running C code}
+\subsection{ss:parallel-execution-long-running-c-code}{Parallel execution of long-running C code}
The OCaml run-time system is not reentrant: at any time, at most one
thread can be executing OCaml code or C code that uses the OCaml
system.
\end{itemize}
+These functions poll for pending signals by calling asynchronous
+callbacks (section~\ref{ss:c-process-pending-actions}) before releasing and
+after acquiring the lock. They can therefore execute arbitrary OCaml
+code including raising an asynchronous exception.
+
After "caml_release_runtime_system()" was called and until
"caml_acquire_runtime_system()" is called, the C code must not access
any OCaml data, nor call any function of the run-time system, nor call
Intuition: a ``blocking section'' is a piece of C code that does not
use the OCaml run-time system, typically a blocking input/output operation.
-\section{Advanced topic: interfacing with Windows Unicode APIs}
-\label{s:interfacing-windows-unicode-apis}
+\section{s:interfacing-windows-unicode-apis}{Advanced topic: interfacing with Windows Unicode APIs}
This section contains some general guidelines for writing C stubs that use
Windows Unicode APIs.
\begin{verbatim}
/* The following define is necessary because the API is experimental */
+#define CAML_NAME_SPACE
#define CAML_INTERNALS
#include <caml/mlvalues.h>
}
\end{verbatim}
-\section{Building mixed C/OCaml libraries: \texttt{ocamlmklib}}
-\label{s-ocamlmklib}
+\section{s:ocamlmklib}{Building mixed C/OCaml libraries: \texttt{ocamlmklib}}
The "ocamlmklib" command facilitates the construction of libraries
containing both OCaml code and C code, and usable both in static
("-L/usr/local/zlib") must be given on all three invocations of "ocamlmklib",
because they are needed at different times depending on whether shared
libraries are supported.
+
+
+\section{s:c-internal-guidelines}{Cautionary words: the internal runtime API}
+
+Not all header available in the "caml/" directory were described in previous
+sections. All those unmentioned headers are part of the internal runtime API,
+for which there is \emph{no} stability guarantee. If you really need access
+to this internal runtime API, this section provides some guidelines
+that may help you to write code that might not break on every new version
+of OCaml.
+\paragraph{Note} Programmers which come to rely on the internal API
+for a use-case which they find realistic and useful are encouraged to open
+a request for improvement on the bug tracker.
+
+\subsection{ss:c-internals}{Internal variables and CAML_INTERNALS}
+Since OCaml 4.04, it is possible to get access to every part of the internal
+runtime API by defining the "CAML_INTERNALS" macro before loading caml header files.
+If this macro is not defined, parts of the internal runtime API are hidden.
+
+If you are using internal C variables, do not redefine them by hand. You should
+import those variables by including the corresponding header files. The
+representation of those variables has already changed once in OCaml 4.10, and is
+still under evolution.
+If your code relies on such internal and brittle properties, it will be broken
+at some point in time.
+
+For instance, rather than redefining "caml_young_limit":
+\begin{verbatim}
+extern int caml_young_limit;
+\end{verbatim}
+which breaks in OCaml $\ge$ 4.10, you should include the "minor_gc" header:
+\begin{verbatim}
+#include <caml/minor_gc.h>
+\end{verbatim}
+
+\subsection{ss:c-internal-macros}{OCaml version macros}
+Finally, if including the right headers is not enough, or if you need to support
+version older than OCaml 4.04, the header file "caml/version.h" should help
+you to define your own compatibility layer.
+This file provides few macros defining the current OCaml version.
+In particular, the "OCAML_VERSION" macro describes the current version,
+its format is "MmmPP".
+For example, if you need some specific handling for versions older than 4.10.0,
+you could write
+\begin{verbatim}
+#include <caml/version.h>
+#if OCAML_VERSION >= 41000
+...
+#else
+...
+#endif
+\end{verbatim}
(Addison-Wesley, 1986), or ``Lex $\&$ Yacc'', by Levine, Mason and
Brown (O'Reilly, 1992).
-\section{Overview of \texttt{ocamllex}}
+\section{s:ocamllex-overview}{Overview of \texttt{ocamllex}}
The "ocamllex" command produces a lexical analyzer from a set of regular
expressions with attached semantic actions, in the style of
by the generated parsing module. (See the description of "ocamlyacc"
below.)
-\subsection{Options}
+\subsection{ss:ocamllex-options}{Options}
The following command-line options are recognized by "ocamllex".
\begin{options}
%
\end{options}
-\section{Syntax of lexer definitions}
+\section{s:ocamllex-syntax}{Syntax of lexer definitions}
The format of lexer definitions is as follows:
\begin{alltt}
Refill handlers are a recent (optional) feature introduced in 4.02,
documented below in subsection~\ref{ss:refill-handlers}.
-\subsection{Header and trailer}
+\subsection{ss:ocamllex-header-trailer}{Header and trailer}
The {\it header} and {\it trailer} sections are arbitrary OCaml
text enclosed in curly braces. Either or both can be omitted. If
present, the header text is copied as is at the beginning of the
by the actions, and possibly some auxiliary functions used in the
actions.
-\subsection{Naming regular expressions}
+\subsection{ss:ocamllex-named-regexp}{Naming regular expressions}
Between the header and the entry points, one can give names to
frequently-occurring regular expressions. This is written
In regular expressions that follow this declaration, the identifier
\var{ident} can be used as shorthand for \var{regexp}.
-\subsection{Entry points}
+\subsection{ss:ocamllex-entry-points}{Entry points}
The names of the entry points must be valid identifiers for OCaml
values (starting with a lowercase letter).
-\subsection{Regular expressions}
+\subsection{ss:ocamllex-regexp}{Regular expressions}
The regular expressions are in the style of "lex", with a more
OCaml-like syntax.
followed by "*", "+" and "?",
then concatenation, then "|" (alternation), then "as".
-\subsection{Actions}
+\subsection{ss:ocamllex-actions}{Actions}
The actions are arbitrary OCaml expressions. They are evaluated in
a context where the identifiers defined by using the "as" construct
\end{options}
-\subsection{Variables in regular expressions}
+\subsection{ss:ocamllex-variables}{Variables in regular expressions}
The "as" construct is similar to ``\emph{groups}'' as provided by
numerous regular expression packages.
The type of these variables can be "string", "char", "string option"
bindings.
The selected set of bindings is purposely left unspecified.
-\subsection{Refill handlers}
-\label{ss:refill-handlers}
+\subsection{ss:refill-handlers}{Refill handlers}
By default, when ocamllex reaches the end of its lexing buffer, it
will silently call the "refill_buff" function of "lexbuf" structure
}
\end{verbatim}
-\subsection{Reserved identifiers}
+\subsection{ss:ocamllex-reserved-ident}{Reserved identifiers}
All identifiers starting with "__ocaml_lex" are reserved for use by
"ocamllex"; do not use any such identifier in your programs.
-\section{Overview of \texttt{ocamlyacc}}
+\section{s:ocamlyacc-overview}{Overview of \texttt{ocamlyacc}}
The "ocamlyacc" command produces a parser from a context-free grammar
specification with attached semantic actions, in the style of "yacc".
the concrete type "token", defined in the interface file
\var{grammar}".mli" produced by "ocamlyacc".
-\section{Syntax of grammar definitions}
+\section{s:ocamlyacc-syntax}{Syntax of grammar definitions}
Grammar definitions have the following format:
\begin{alltt}
``declarations'' and ``rules'' sections, and between \verb|(*| and
\verb|*)| (as in OCaml) in the ``header'' and ``trailer'' sections.
-\subsection{Header and trailer}
+\subsection{ss:ocamlyacc-header-trailer}{Header and trailer}
The header and the trailer sections are OCaml code that is copied
as is into file \var{grammar}".ml". Both sections are optional. The header
"open" directives and auxiliary functions required by the semantic
actions of the rules. The trailer goes at the end of the output file.
-\subsection{Declarations}
+\subsection{ss:ocamlyacc-declarations}{Declarations}
Declarations are given one per line. They all start with a \verb"%" sign.
\end{options}
-\subsection{Rules}
+\subsection{ss:ocamlyacc-rules}{Rules}
The syntax for rules is as usual:
\begin{alltt}
Nonterminal symbols are like regular OCaml symbols, except that they
cannot end with "'" (single quote).
-\subsection{Error handling}
+\subsection{ss:ocamlyacc-error-handling}{Error handling}
Error recovery is supported as follows: when the parser reaches an
error state (no grammar rules can apply), it calls a function named
Refer to documentation on "yacc" for more details and guidance in how
to use error recovery.
-\section{Options}
+\section{s:ocamlyacc-options}{Options}
The "ocamlyacc" command recognizes the following options:
At run-time, the "ocamlyacc"-generated parser can be debugged by
setting the "p" option in the "OCAMLRUNPARAM" environment variable
-(see section~\ref{ocamlrun-options}). This causes the pushdown
+(see section~\ref{s:ocamlrun-options}). This causes the pushdown
automaton executing the parser to print a trace of its action (tokens
shifted, rules reduced, etc). The trace mentions rule numbers and
state numbers that can be interpreted by looking at the file
\var{grammar}".output" generated by "ocamlyacc -v".
-\section{A complete example}
+\section{s:lexyacc-example}{A complete example}
The all-time favorite: a desk calculator. This program reads
arithmetic expressions on standard input, one per line, and prints
ocamlc -o calc lexer.cmo parser.cmo calc.cmo
\end{verbatim}
-\section{Common errors}
+\section{s:lexyacc-common-errors}{Common errors}
\begin{options}
object files produced by "ocamlopt" cannot be loaded in the toplevel
system "ocaml".
-\section{Overview of the compiler}
+\section{s:native-overview}{Overview of the compiler}
The "ocamlopt" command has a command-line interface very close to that
of "ocamlc". It accepts the same types of arguments, and processes them
These ".cmt" and ".cmti" files are typically useful for code inspection tools.
-\section{Options}
+\section{s:native-options}{Options}
The following command-line options are recognized by "ocamlopt".
The options "-pack", "-a", "-shared", "-c" and "-output-obj" are mutually
configured value. Primarily used for bootstrapping.
\end{options}
-\section{Common errors}
+\section{s:native-common-errors}{Common errors}
The error messages are almost identical to those of "ocamlc".
See section~\ref{s:comp-errors}.
-\section{Running executables produced by ocamlopt}
+\section{s:native:running-executable}{Running executables produced by ocamlopt}
Executables generated by "ocamlopt" are native, stand-alone executable
files that can be invoked directly. They do
the following environment variables are also consulted:
\begin{options}
\item["OCAMLRUNPARAM"] Same usage as in "ocamlrun"
- (see section~\ref{ocamlrun-options}), except that option "l"
+ (see section~\ref{s:ocamlrun-options}), except that option "l"
is ignored (the operating system's stack size limit
is used instead).
\item["CAMLRUNPARAM"] If "OCAMLRUNPARAM" is not found in the
"CAMLRUNPARAM" is not found, then the default values will be used.
\end{options}
-\section{Compatibility with the bytecode compiler}
-\label{s:compat-native-bytecode}
+\section{s:compat-native-bytecode}{Compatibility with the bytecode compiler}
This section lists the known incompatibilities between the bytecode
compiler and the native-code compiler. Except on those points, the two
piece of code that does not allocate, its handler will not be called
until the next heap allocation.
-\item Stack overflow, typically caused by excessively deep recursion,
-is not always turned into a "Stack_overflow" exception like the
-bytecode compiler does. The runtime system makes a best effort to
-trap stack overflows and raise the "Stack_overflow" exception, but
-sometimes it fails and a ``segmentation fault'' or another system fault
-occurs instead.
-
\item On ARM and PowerPC processors (32 and 64 bits), fused
multiply-add (FMA) instructions can be generated for a
floating-point multiplication followed by a floating-point addition
not referenced. See also the "Sys.opaque_identity" function from the
"Sys" standard library module.
+\item Before 4.10, stack overflows, typically caused by excessively
+ deep recursion, are not always turned into a "Stack_overflow"
+ exception like with the bytecode compiler. The runtime system makes
+ a best effort to trap stack overflows and raise the "Stack_overflow"
+ exception, but sometimes it fails and a ``segmentation fault'' or
+ another system fault occurs instead.
+
\end{itemize}
Dependencies are generated both for compiling with the bytecode
compiler "ocamlc" and with the native-code compiler "ocamlopt".
-\section{Options}
+\section{s:ocamldep-options}{Options}
The following command-line options are recognized by "ocamldep".
%
\end{options}
-\section{A typical Makefile}
+\section{s:ocamldep-makefile}{A typical Makefile}
Here is a template "Makefile" for a OCaml program.
field, a class, a class type, a class method, a class value or a class
inheritance clause.
-\section{Usage} \label{s:ocamldoc-usage}
+\section{s:ocamldoc-usage}{Usage}
-\subsection{Invocation}
+\subsection{ss:ocamldoc-invocation}{Invocation}
OCamldoc is invoked via the command "ocamldoc", as follows:
\begin{alltt}
ocamldoc \var{options} \var{sourcefiles}
\end{alltt}
-\subsubsection*{Options for choosing the output format}
+\subsubsection*{sss:ocamldoc-output}{Options for choosing the output format}
The following options determine the format for the generated
documentation.
\item["-g" \var{file.cm[o,a,xs]}]
Dynamically load the given file, which defines a custom documentation
-generator. See section \ref{s:ocamldoc-compilation-and-usage}. This
+generator. See section \ref{ss:ocamldoc-compilation-and-usage}. This
option is supported by the "ocamldoc" command (to load ".cmo" and ".cma" files)
and by its native-code version "ocamldoc.opt" (to load ".cmxs" files).
If the given file is a simple one and does not exist in
\end{options}
-\subsubsection*{General options}
+\subsubsection*{sss:ocamldoc-options}{General options}
\begin{options}
\item["-m" \var{flags}]
Specify merge options between interfaces and implementations.
-(see section \ref{s:ocamldoc-merge} for details).
+(see section \ref{ss:ocamldoc-merge} for details).
\var{flags} can be one or several of the following characters:
\begin{options}
\item["d"] merge description
\end{options}
\item["-no-custom-tags"]
-Do not allow custom \@-tags (see section \ref{s:ocamldoc-tags}).
+Do not allow custom \@-tags (see section \ref{ss:ocamldoc-tags}).
\item["-no-stop"]
Keep elements placed after/between the "(**/**)" special comment(s)
%
\end{options}
-\subsubsection*{Type-checking options}
+\subsubsection*{sss:ocamldoc-type-checking}{Type-checking options}
OCamldoc calls the OCaml type-checker to obtain type
information. The following options impact the type-checking phase.
\end{options}
-\subsubsection*{Options for generating HTML pages}
+\subsubsection*{sss:ocamldoc-html}{Options for generating HTML pages}
The following options apply in conjunction with the "-html" option:
\end{options}
-\subsubsection*{Options for generating \LaTeX\ files}
+\subsubsection*{sss:ocamldoc-latex}{Options for generating \LaTeX\ files}
The following options apply in conjunction with the "-latex" option:
"ocamldoc.out" file.
\end{options}
-\subsubsection*{Options for generating TeXinfo files}
+\subsubsection*{sss:ocamldoc-info}{Options for generating TeXinfo files}
The following options apply in conjunction with the "-texi" option:
Suppress trailer in generated documentation.
\end{options}
-\subsubsection*{Options for generating "dot" graphs}
+\subsubsection*{sss:ocamldoc-dot}{Options for generating "dot" graphs}
The following options apply in conjunction with the "-dot" option:
the module dependency graph.
\end{options}
-\subsubsection*{Options for generating man files}
+\subsubsection*{sss:ocamldoc-man}{Options for generating man files}
The following options apply in conjunction with the "-man" option:
\end{options}
-\subsection{Merging of module information}
-\label{s:ocamldoc-merge}
+\subsection{ss:ocamldoc-merge}{Merging of module information}
Information on a module can be extracted either from the ".mli" or ".ml"
file, or both, depending on the files given on the command line.
In either case, all the information given in the ".mli" file is kept.
\end{itemize}
-\subsection{Coding rules}
-\label{s:ocamldoc-rules}
+\subsection{ss:ocamldoc-rules}{Coding rules}
The following rules must be respected in order to avoid name clashes
resulting in cross-reference errors:
\begin{itemize}
opened module "Foo".
\end{itemize}
-\section{Syntax of documentation comments}
-\label{s:ocamldoc-comments}
+\section{s:ocamldoc-comments}{Syntax of documentation comments}
Comments containing documentation material are called {\em special
comments} and are written between "(**" and "*)". Special comments
must start exactly with "(**". Comments beginning with "(" and more
than two "*" are ignored.
-\subsection{Placement of documentation comments}
+\subsection{ss:ocamldoc-placement}{Placement of documentation comments}
OCamldoc can associate comments to some elements of the language
encountered in the source files. The association is made according to
the locations of comments with respect to the language elements. The
locations of comments in ".mli" and ".ml" files are different.
%%%%%%%%%%%%%
-\subsubsection{Comments in ".mli" files}
+\subsubsection{sss:ocamldoc-mli}{Comments in ".mli" files}
A special comment is associated to an element if it is placed before or
after the element.\\
A special comment before an element is associated to this element if~:
\end{caml_example*}
%%%%%%%%%%%%%
-\subsubsection{Comments in {\tt .ml} files}
+\subsubsection{sss:ocamldoc-comments-ml}{Comments in {\tt .ml} files}
A special comment is associated to an element if it is placed before
the element and there is no blank line between the comment and the
\end{caml_example}
%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{The Stop special comment}
+\subsection{ss:ocamldoc-stop}{The Stop special comment}
The special comment "(**/**)" tells OCamldoc to discard
elements placed after this comment, up to the end of the current
class, class type, module or module type, or up to the next stop comment.
comments to be ignored.
%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{Syntax of documentation comments}
+\subsection{ss:ocamldoc-syntax}{Syntax of documentation comments}
The inside of documentation comments "(**"\ldots"*)" consists of
free-form text with optional formatting annotations, followed by
% enable section numbering for subsubsections (PR#6189, item 3)
\setcounter{secnumdepth}{3}
-\subsection{Text formatting}
+\subsection{ss:ocamldoc-formatting}{Text formatting}
Here is the BNF grammar for the simple markup language used to format
text descriptions.
@||@&@ '{v' string 'v}' @ & set the given @string@ in verbatim style. \\
@||@&@ '{%' string '%}' @ & target-specific content
(\LaTeX\ code by default, see details
- in \ref{sss:target-specific-syntax}) \\
+ in \ref{sss:ocamldoc-target-specific-syntax}) \\
@||@&@ '{!' string '}' @ & insert a cross-reference to an element
- (see section \ref{sss:crossref} for the syntax of cross-references).\\
+ (see section \ref{sss:ocamldoc-crossref} for the syntax of cross-references).\\
@||@&@ '{!modules:' string string ... '}' @ & insert an index table
for the given module names. Used in HTML only.\\
@||@&@ '{!indexlist}' @ & insert a table of links to the various indexes
@||@& \nt{blank-line} & force a new line.
\end{tabular} \\
-\subsubsection{List formatting}
+\subsubsection{sss:ocamldoc-list}{List formatting}
\begin{syntax}
list:
instead of '"-"'.
Note that only one list can be defined by this shortcut in nested lists.
-\subsubsection{Cross-reference formatting}
-\label{sss:crossref}
+\subsubsection{sss:ocamldoc-crossref}{Cross-reference formatting}
Cross-references are fully qualified element names, as in the example
"{!Foo.Bar.t}". This is an ambiguous reference as it may designate
referenced as "{!tree.Node}" or "{!const:tree.Node}", or possibly
"{!Mod1.Mod2.tree.Node}" from outside the module.
-\subsubsection{First sentence}
+\subsubsection{sss:ocamldoc-preamble}{First sentence}
In the description of a value, type, exception, module, module type, class
or class type, the {\em first sentence} is sometimes used in indexes, or
@ '{^' text '}' @,
@ '{_' text '}' @.
-\subsubsection{Target-specific formatting}
-\label{sss:target-specific-syntax}
+\subsubsection{sss:ocamldoc-target-specific-syntax}{Target-specific formatting}
The content inside "{%foo: ... %}" is target-specific and will only be
interpreted by the backend "foo", and ignored by the others. The
no target is specified (syntax "{% ... %}"), "latex" is chosen by
default. Custom generators may support their own target prefix.
-\subsubsection{Recognized HTML tags}
+\subsubsection{sss:ocamldoc-html-tags}{Recognized HTML tags}
The HTML tags "<b>..</b>",
"<code>..</code>",
"<i>..</i>",
\setcounter{secnumdepth}{2}
%%%%%%%%%%%%%
-\subsection{Documentation tags (\@-tags)}
-\label{s:ocamldoc-tags}
+\subsection{ss:ocamldoc-tags}{Documentation tags (\@-tags)}
-\subsubsection{Predefined tags}
+
+\subsubsection{sss:ocamldoc-builtin-tags}{Predefined tags}
The following table gives the list of predefined \@-tags, with their
syntax and meaning.\\
@ "@version" string @ & The version number for the element. \\ \hline
\end{tabular}
-\subsubsection{Custom tags}
-\label{s:ocamldoc-custom-tags}
+\subsubsection{sss:ocamldoc-custom-tags}{Custom tags}
You can use custom tags in the documentation comments, but they will
have no effect if the generator used does not handle them. To use a
custom tag, for example "foo", just put "\@foo" with some text in your
\end{verbatim}
To handle custom tags, you need to define a custom generator,
-as explained in section \ref{s:ocamldoc-handling-custom-tags}.
+as explained in section \ref{ss:ocamldoc-handling-custom-tags}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Custom generators}
-\label{s:ocamldoc-custom-generators}
+\section{s:ocamldoc-custom-generators}{Custom generators}
OCamldoc operates in two steps:
\begin{enumerate}
"ocamldoc" sub-directory of the OCaml standard library.
%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{The generator modules}
+\subsection{ss:ocamldoc-generators}{The generator modules}
The type of a generator module depends on the kind of generated documentation.
Here is the list of generator module types, with the name of the generator
class in the module~:
kind as the one you want to define. Doing so, it is possible to
load various custom generators to combine improvements brought by each one.
-This is done using first class modules (see chapter \ref{s-first-class-modules}).
+This is done using first class modules (see chapter \ref{s:first-class-modules}).
The easiest way to define a custom generator is the following this example,
here extending the current HTML generator. We don't have to know if this is
\end{itemize}
%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{Handling custom tags}
-\label{s:ocamldoc-handling-custom-tags}
+\subsection{ss:ocamldoc-handling-custom-tags}{Handling custom tags}
Making a custom generator handle custom tags (see
-\ref{s:ocamldoc-custom-tags}) is very simple.
+\ref{sss:ocamldoc-custom-tags}) is very simple.
-\subsubsection*{For HTML}
+\subsubsection*{sss:ocamldoc-html-generator}{For HTML}
Here is how to develop a HTML generator handling your custom tags.
The class "Odoc_html.Generator.html" inherits
the tag. If no function is associated to a custom tag, then the method
prints a warning message on "stderr".
-\subsubsection{For other generators}
+\subsubsection{sss:ocamldoc-other-generators}{For other generators}
You can act the same way for other kinds of generators.
%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Adding command line options}
+\section{s:ocamldoc-adding-flags}{Adding command line options}
The command line analysis is performed after loading the module containing the
documentation generator, thus allowing command line options to be added to the
list of existing ones. Adding an option can be done with the function
this function.
%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{Compilation and usage}
-\label{s:ocamldoc-compilation-and-usage}
+\subsection{ss:ocamldoc-compilation-and-usage}{Compilation and usage}
%%%%%%%%%%%%%%
-\subsubsection{Defining a custom generator class in one file}
+\subsubsection{sss:ocamldoc-generator-class}{Defining a custom generator class in one file}
Let "custom.ml" be the file defining a new generator class.
Compilation of "custom.ml" can be performed by the following command~:
\begin{alltt}
custom one is ignored.
%%%%%%%%%%%%%%
-\subsubsection{Defining a custom generator class in several files}
+\subsubsection{sss:ocamldoc-modular-generator}{Defining a custom generator class in several files}
It is possible to define a generator class in several modules, which
are defined in several files \var{\nth{file}{1}}".ml"["i"],
\var{\nth{file}{2}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]. A ".cma"
programs can be profiled, by recording how many times functions are
called, branches of conditionals are taken, \ldots
-\section{Compiling for profiling}
+\section{s:ocamlprof-compiling}{Compiling for profiling}
Before profiling an execution, the program must be compiled in
profiling mode, using the "ocamlcp" front-end to the "ocamlc" compiler
also be used (though this is not strictly necessary) when linking them
together.
-\paragraph{Note} If a module (".ml" file) doesn't have a corresponding
+\lparagraph{p:ocamlprof-warning}{Note} If a module (".ml" file) doesn't have a corresponding
interface (".mli" file), then compiling it with "ocamlcp" will produce
object files (".cmi" and ".cmo") that are not compatible with the ones
produced by "ocamlc", which may lead to problems (if the ".cmi" or
have a ".mli" file for each ".ml" file. The same problem exists with
"ocamloptp".
-\paragraph{Note} To make sure your programs can be compiled in
+\lparagraph{p:ocamlprof-reserved}{Note} To make sure your programs can be compiled in
profiling mode, avoid using any identifier that begins with
"__ocaml_prof".
(preprocessing) option.
-\section{Profiling an execution}
+\section{s:ocamlprof-profiling}{Profiling an execution}
Running an executable that has been compiled with "ocamlcp" or
"ocamloptp" records the execution counts for the specified parts of
executables (compiled with "ocamlcp") are compatible with the dump
files produced by native executables (compiled with "ocamloptp").
-\section{Printing profiling information}
+\section{s:ocamlprof-printing}{Printing profiling information}
The "ocamlprof" command produces a source listing of the program modules
where execution counts have been inserted as comments. For instance,
%
\end{options}
-\section{Time profiling}
+\section{s:ocamlprof-time-profiling}{Time profiling}
Profiling with "ocamlprof" only records execution counts, not the actual
time spent within each function. There is currently no way to perform
The "ocamlrun" command executes bytecode files produced by the
linking phase of the "ocamlc" command.
-\section{Overview}
+\section{s:ocamlrun-overview}{Overview}
The "ocamlrun" command comprises three main parts: the bytecode
interpreter, that actually executes bytecode files; the memory
with "ocamlc -o myprog.exe ..." rather than "ocamlc -o myprog ...".
\end{windows}
-\section{Options} \label{ocamlrun-options}
-
+\section{s:ocamlrun-options}{Options}
The following command-line options are recognized by "ocamlrun".
\begin{options}
\item["-I" \var{dir}]
Search the directory \var{dir} for dynamically-loaded libraries,
in addition to the standard search path (see
-section~\ref{s-ocamlrun-dllpath}).
+section~\ref{s:ocamlrun-dllpath}).
\item["-m"]
Print the magic number of the bytecode executable given as argument
and exit.
\begin{options}
\item["CAML_LD_LIBRARY_PATH"] Additional directories to search for
- dynamically-loaded libraries (see section~\ref{s-ocamlrun-dllpath}).
+ dynamically-loaded libraries (see section~\ref{s:ocamlrun-dllpath}).
\item["OCAMLLIB"] The directory containing the OCaml standard
library. (If "OCAMLLIB" is not set, "CAMLLIB" will be used instead.)
Used to locate the "ld.conf" configuration file for
- dynamic loading (see section~\ref{s-ocamlrun-dllpath}). If not set,
+ dynamic loading (see section~\ref{s:ocamlrun-dllpath}). If not set,
default to the library directory specified when compiling OCaml.
\item["OCAMLRUNPARAM"] Set the runtime system options
\fi
This option takes no argument.
\item[h] The initial size of the major heap (in words).
- \item[a] ("allocation_policy") The policy used for allocating in the
- OCaml heap. Possible values are 0 for the next-fit policy, and 1
- for the first-fit policy. Next-fit is usually faster, but first-fit
- is better for avoiding fragmentation and the associated heap
- compactions.
+ \item[a] ("allocation_policy")
+ The policy used for allocating in the OCaml heap. Possible values
+ are "0" for the next-fit policy, "1" for the first-fit
+ policy, and "2" for the best-fit policy. Best-fit is still experimental,
+ but probably the best of the three. The default is "0" (next-fit).
+ See the Gc module documentation for details.
\item[s] ("minor_heap_size") Size of the minor heap. (in words)
\item[i] ("major_heap_increment") Default size increment for the
major heap. (in words)
\item[o] ("space_overhead") The major GC speed setting.
+ See the Gc module documentation for details.
\item[O] ("max_overhead") The heap compaction trigger setting.
\item[l] ("stack_limit") The limit (in words) of the stack size.
\item[v] ("verbose") What GC messages to print to stderr. This
\item[1024 (= 0x400)] Output GC statistics at program exit.
\end{options}
\item[c] ("cleanup_on_exit") Shut the runtime down gracefully on exit (see
- "caml_shutdown" in section~\ref{s:embedded-code}). The option also enables
+ "caml_shutdown" in section~\ref{ss:c-embedded-code}). The option also enables
pooling (as in "caml_startup_pooled"). This mode can be used to detect
leaks with a third-party memory debugger.
% FIXME missing: H, t, w, W see MPR#7870
executable file.
\end{options}
-\section{Dynamic loading of shared libraries} \label{s-ocamlrun-dllpath}
+\section{s:ocamlrun-dllpath}{Dynamic loading of shared libraries}
On platforms that support dynamic loading, "ocamlrun" can link
dynamically with C shared libraries (DLLs) providing additional C primitives
beyond those provided by the standard runtime system. The names for
these libraries are provided at link time as described in
-section~\ref{dynlink-c-code}), and recorded in the bytecode executable
+section~\ref{ss:dynlink-c-code}), and recorded in the bytecode executable
file; "ocamlrun", then, locates these libraries and resolves references
to their primitives when the bytecode executable program starts.
environment variable.
\end{enumerate}
-\section{Common errors}
+\section{s:ocamlrun-common-errors}{Common errors}
This section describes and explains the most frequently encountered
error messages.
\chapter{Memory profiling with Spacetime}
%HEVEA\cutname{spacetime.html}
-\section{Overview}
+\section{s:spacetime-overview}{Overview}
Spacetime is the name given to functionality within the OCaml compiler that
provides for accurate profiling of the memory behaviour of a program.
the OCaml heap allocators and garbage collector. It does not analyse
allocation on the C heap. Spacetime does not affect the memory behaviour
of a program being profiled with the exception of any change caused by the
-overhead of profiling (see section\ \ref{runtimeoverhead})---for example
+overhead of profiling (see section\ \ref{s:spacetime-runtimeoverhead})---for example
the program running slower might cause it to allocate less memory in total.
Spacetime is currently only available for x86-64 targets and has only been
Windows). It is expected that the set of supported platforms will
be extended in the future.
-\section{How to use it}
+\section{s:spacetime-howto}{How to use it}
-\subsection{Building}
+\subsection{ss:spacetime-building}{Building}
To use Spacetime it is necessary to use an OCaml compiler that was
configured with the {\tt -spacetime} option. It is not possible to select
counterparts. It is hoped this will be fixed in the future as part of
improved cross compilation support.
-\subsection{Running}
+\subsection{ss:spacetime-running}{Running}
Programs built with Spacetime instrumentation have a dependency on
the {\tt libunwind} library unless that was unavailable at configure time or
the {\tt -disable-libunwind} option was specified
-(see section\ \ref{runtimeoverhead}).
+(see section\ \ref{s:spacetime-runtimeoverhead}).
Setting the {\tt OCAML\_SPACETIME\_INTERVAL} environment variable to an
integer representing a number of milliseconds before running a program built
is provided in the standard library documentation (section\ \ref{c:stdlib})
for the {\tt Spacetime} module.
-\subsection{Analysis}
+\subsection{ss:spacetime-analysis}{Analysis}
The compiler distribution does not itself provide the facility for analysing
Spacetime output files; this is left to external tools. The first such tool
provide interactive graphical and terminal-based visualisation of
the results of profiling.
-\section{Runtime overhead}\label{runtimeoverhead}
+\section{s:spacetime-runtimeoverhead}{Runtime overhead}
The runtime overhead imposed by Spacetime varies considerably depending on
the particular program being profiled. The overhead may be as low as
memory than their non-instrumented counterparts. It is expected that this
memory overhead will also be reduced in the future.
-\section{For developers}
+\section{s:spacetime-dev}{For developers}
The compiler distribution provides an ``{\tt otherlibs}'' library called
{\tt raw\_spacetime\_lib} for decoding Spacetime files. This library
and executed as per the "#use" directive
described in section~\ref{s:toplevel-directives}.
The evaluation outcode for each phrase are not displayed.
-If the current directory does not contain an ".ocamlinit" file, but
-the user's home directory (environment variable "HOME") does, the
-latter is read and executed as described below.
+If the current directory does not contain an ".ocamlinit" file,
+the file "XDG_CONFIG_HOME/ocaml/init.ml" is looked up according
+to the XDG base directory specification and used instead (on Windows
+this is skipped). If that file doesn't exist then an [.ocamlinit] file
+in the users' home directory (determined via environment variable "HOME") is
+used if existing.
The toplevel system does not perform line editing, but it can
easily be used in conjunction with an external line editor such as
-"ledit", "ocaml2" or "rlwrap"
-\begin{latexonly}
-(see the Caml Hump "http://caml.inria.fr/humps/index_framed_caml.html").
-\end{latexonly}
-\begin{htmlonly}
-(see the
-\ahref{http://caml.inria.fr/humps/index\_framed\_caml.html}{Caml Hump}).
-\end{htmlonly}
+"ledit", or "rlwrap". An improved toplevel, "utop", is also available.
Another option is to use "ocaml" under Gnu Emacs, which gives the
full editing power of Emacs (command "run-caml" from library "inf-caml").
\end{unix}
-\section{Options} \label{s:toplevel-options}
+\section{s:toplevel-options}{Options}
The following command-line options are recognized by the "ocaml" command.
% Configure boolean variables used by the macros in unified-options.etex
consults the "TERM" variable to determines the type of output terminal
and look up its capabilities in the terminal database.
-\item["HOME"] Directory where the ".ocamlinit" file is searched.
+\item["XDG_CONFIG_HOME", "HOME"]
+".ocamlinit" lookup procedure (see above).
\end{options}
\end{unix}
-\section{Toplevel directives}
-\label{s:toplevel-directives}
+\section{s:toplevel-directives}{Toplevel directives}
The following directives control the toplevel behavior, load files in
memory, and trace program execution.
\end{options}
-\section{The toplevel and the module system} \label{s:toplevel-modules}
+\section{s:toplevel-modules}{The toplevel and the module system}
Toplevel phrases can refer to identifiers defined in compilation units
with the same mechanisms as for separately compiled units: either by
``reference to undefined global \var{Mod}'' will occur only when
executing a value or module definition that refers to \var{Mod}.
-\section{Common errors}
+\section{s:toplevel-common-errors}{Common errors}
This section describes and explains the most frequently encountered
error messages.
\end{options}
-\section{Building custom toplevel systems: \texttt{ocamlmktop}}
+\section{s:custom-toplevel}{Building custom toplevel systems: \texttt{ocamlmktop}}
The "ocamlmktop" command builds OCaml toplevels that
contain user code preloaded at start-up.
\end{verbatim}
yourself, if this is what you wish.
-\subsection{Options}
+\subsection{ss:ocamlmktop-options}{Options}
The following command-line options are recognized by "ocamlmktop".
\end{options}
-\section{The native toplevel: \texttt{ocamlnat}\ (experimental)}
+\section{s:ocamlnat}{The native toplevel: \texttt{ocamlnat}\ (experimental)}
{\bf This section describes a tool that is not yet officially supported %
but may be found useful.}
standard search path (the one corresponding to the "-I" option).
The "-dllpath" option simply stores \var{dir} in the produced
executable file, where "ocamlrun" can find it and use it as
-described in section~\ref{s-ocamlrun-dllpath}.
+described in section~\ref{s:ocamlrun-dllpath}.
}%comp
\notop{%
required in order to \comp{be able to debug the program with "ocamldebug"
(see chapter~\ref{c:debugger}), and to} produce stack backtraces when
the program terminates on an uncaught exception (see
-section~\ref{ocamlrun-options}).
+section~\ref{s:ocamlrun-options}).
}%notop
\notop{%
\item["-init" \var{file}]
Load the given file instead of the default initialization file.
The default file is ".ocamlinit" in the current directory if it
-exists, otherwise ".ocamlinit" in the user's home directory.
+exists, otherwise "XDG_CONFIG_HOME/ocaml/init.ml" or
+".ocamlinit" in the user's home directory.
}%top
\notop{%
line. This custom runtime system can be used later to execute
bytecode executables produced with the
"ocamlc -use-runtime" \var{runtime-name} option.
-See section~\ref{s:custom-runtime} for more information.
+See section~\ref{ss:custom-runtime} for more information.
}%comp
\notop{%
\comp{a bytecode executable file}\nat{an executable file}.
This is useful to wrap OCaml code as a C library,
callable from any C program. See chapter~\ref{c:intf-c},
-section~\ref{s:embedded-code}. The name of the output object file
+section~\ref{ss:c-embedded-code}. The name of the output object file
must be set with the "-o" option.
This option can also be used to produce a \comp{C source file (".c" extension)
or a} compiled shared/dynamic library (".so" extension, ".dll" under Windows).
}%notop
+\comp{%
+\item["-output-complete-exe"]
+Build a self-contained executable by linking a C object file containing the
+bytecode program, the OCaml runtime system and any other static C code given to
+"ocamlc". The resulting effect is similar to "-custom", except that the bytecode
+is embedded in the C code so it is no longer accessible to tools such as
+"ocamldebug". On the other hand, the resulting binary is resistant to "strip".
+}%comp
+
\nat{%
\item["-pack"]
Build an object file (".cmx" and ".o"/".obj" files) and its associated compiled
Generate a bytecode executable file that can be executed on the custom
runtime system \var{runtime-name}, built earlier with
"ocamlc -make-runtime" \var{runtime-name}.
-See section~\ref{s:custom-runtime} for more information.
+See section~\ref{ss:custom-runtime} for more information.
}%comp
\item["-v"]
\end{latexonly}
\end{itemize}
-\section*{Conventions}
+\section*{conventions}{Conventions}
OCaml runs on several operating systems. The parts of
this manual that are specific to one operating system are presented as
(XP, Vista, 7, 8, 10).
\end{windows}
-\section*{License}
+\section*{license}{License}
The OCaml system is copyright \copyright\ 1996--\number\year\
Institut National de Recherche en Informatique et en
redistributed. See the file "LICENSE" in the distribution for
licensing information.
-The present documentation is copyright \copyright\ \number\year\
+The OCaml documentation and user's manual is
+copyright \copyright\ \number\year\
Institut National de Recherche en Informatique et en
-Automatique (INRIA). The OCaml documentation and user's
-manual may be reproduced and distributed in whole or
-in part, subject to the following conditions:
-\begin{itemize}
-\item The copyright notice above and this permission notice must be
-preserved complete on all complete or partial copies.
-\item Any translation or derivative work of the OCaml
-documentation and user's manual must be approved by the authors in
-writing before distribution.
-\item If you distribute the OCaml
-documentation and user's manual in part, instructions for obtaining
-the complete version of this manual must be included, and a
-means for obtaining a complete version provided.
-\item Small portions may be reproduced as illustrations for reviews or
-quotes in other works without this permission notice if proper
-citation is given.
-\end{itemize}
+Automatique (INRIA).
+
+\begin{latexonly}
+The OCaml documentation and user's manual is licensed under a Creative
+Commons Attribution-ShareAlike 4.0 International License (CC BY-SA
+4.0), \url{https://creativecommons.org/licenses/by-sa/4.0/}.
+\end{latexonly}
+
+\begin{htmlonly}
+\begin{rawhtml}
+<a id="cc_license_logo" rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by-sa/4.0/88x31.png"></a>
+The OCaml documentation and user's manual is licensed under a
+<a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">Creative Commons Attribution-ShareAlike 4.0 International License</a>.
+\end{rawhtml}
+\end{htmlonly}
-\section*{Availability}
+\section*{availability}{Availability}
\begin{latexonly}
The complete OCaml distribution can be accessed via the Web
-\section{Built-in types and predefined exceptions}
+\section{s:core-builtins}{Built-in types and predefined exceptions}
The following built-in types and predefined exceptions are always
defined in the
consequence, they can only be referred by their short names.
%\vspace{0.1cm}
-\subsection*{Built-in types}
+\subsection{ss:builtin-types}*{Built-in types}
%\vspace{0.1cm}
\begin{ocamldoccode}
\end{ocamldocdescription}
%\vspace{0.1cm}
-\subsection*{Predefined exceptions}
+\subsection*{ss:predef-exn}{Predefined exceptions}
%\vspace{0.1cm}
\begin{ocamldoccode}
\end{ocamldoccode}
\index{Outofmemory@\verb`Out_of_memory`}
\begin{ocamldocdescription}
- Exception raised by the garbage collector
- when there is insufficient memory to complete the computation.
+ Exception raised by the garbage collector when there is
+ insufficient memory to complete the computation. (Not reliable for
+ allocations on the minor heap.)
\end{ocamldocdescription}
\begin{ocamldoccode}
\index{Stackoverflow@\verb`Stack_overflow`}
\begin{ocamldocdescription}
Exception raised by the bytecode interpreter when the evaluation
- stack reaches its maximal size. This often indicates infinite
- or excessively deep recursion in the user's program.
- (Not fully implemented by the native-code compiler;
- see section~\ref{s:compat-native-bytecode}.)
+ stack reaches its maximal size. This often indicates infinite or
+ excessively deep recursion in the user's program. Before 4.10, it
+ was not fully implemented by the native-code compiler.
\end{ocamldocdescription}
\begin{ocamldoccode}
\index{Undefinedrecursivemodule@\verb`Undefined_recursive_module`}
\begin{ocamldocdescription}
Exception raised when an ill-founded recursive module definition
- is evaluated. (See section~\ref{s-recursive-modules}.)
+ is evaluated. (See section~\ref{s:recursive-modules}.)
The arguments are the location of the definition in the source code
(file name, line number, column number).
\end{ocamldocdescription}
\end{links}
\else
+{\ocamldocinputstart
% Ast_helper is excluded from the PDF and text manuals.
% It is over 20 pages long and does not have doc-comments. It is expected
% that Ast_helper will be only useful in the HTML manual (to look up signatures).
\input{Parse.tex}
\input{Parsetree.tex}
\input{Pprintast.tex}
+}
% \input{Printast.tex}
\fi
"Stdlib" module, without adding a "open Stdlib" directive.
\end{itemize}
-\section*{Conventions}
+\section*{s:core-conventions}{Conventions}
The declarations of the built-in types and the components of module
"Stdlib" are printed one by one in typewriter font, followed by a
indexed at the end of this report.
\input{builtin.tex}
-
\ifouthtml
-\section{Module {\tt Stdlib}: the initially opened module}
+\section{s:stdlib-module}{Module {\tt Stdlib}: the initially opened module}
\begin{links}
\item \ahref{libref/Stdlib.html}{Module \texttt{Stdlib}: the initially opened module}
\item \ahref{libref/Pervasives.html}{Module \texttt{Pervasives}: deprecated alias for Stdlib}
\end{links}
\else
+{
+\ocamldocinputstart
\input{Stdlib.tex}
+}
\fi
\end{links}
\else
+\ocamldocinputstart
\input{Str.tex}
\fi
\end{windows}
\begin{latexonly}
+{
+\ocamldocinputstart
\input{Unix.tex}
-\section{Module \texttt{UnixLabels}: labelized version of the interface}
+\section{s:Module \texttt{UnixLabels}: labelized version of the interface}
\label{UnixLabels}
\index{UnixLabels (module)@\verb~UnixLabels~ (module)}%
at "unixLabels.mli", or by using the "ocamlbrowser" tool.
\newpage
+}
\end{latexonly}
\begin{windows}
\label{stdlib:top}
-\section*{Conventions}
+\section*{s:stdlib-conv}{Conventions}
For easy reference, the modules are listed below in alphabetical order
of module names.
this report.
\begin{latexonly}
-\section*{Overview}
+\section*{s:stdlib-overview}{Overview}
Here is a short listing, by theme, of the standard library modules.
-\subsubsection*{Data structures:}
+\subsubsection*{sss:stdlib-data-structures}{Data structures:}
\begin{tabular}{lll}
% Beware: these entries must be written in a very rigidly-defined
% format, or the check-stdlib-modules script will complain.
"Ephemeron" & p.~\pageref{Ephemeron} & ephemerons and weak hash tables \\
"Bigarray" & p.~\pageref{Bigarray} & large, multi-dimensional, numerical arrays
\end{tabular}
-\subsubsection*{Arithmetic:}
+\subsubsection*{sss:stdlib-arith}{Arithmetic:}
\begin{tabular}{lll}
"Complex" & p.~\pageref{Complex} & Complex numbers \\
"Float" & p.~\pageref{Float} & Floating-point numbers \\
"Nativeint" & p.~\pageref{Nativeint} & operations on platform-native
integers
\end{tabular}
-\subsubsection{Input/output:}
+\subsubsection{sss:stdlib-io}{Input/output:}
\begin{tabular}{lll}
"Format" & p.~\pageref{Format} & pretty printing with automatic
indentation and line breaking \\
"Scanf" & p.~\pageref{Scanf} & formatted input functions \\
"Digest" & p.~\pageref{Digest} & MD5 message digest \\
\end{tabular}
-\subsubsection{Parsing:}
+\subsubsection{sss:stdlib-parsing}{Parsing:}
\begin{tabular}{lll}
"Genlex" & p.~\pageref{Genlex} & a generic lexer over streams \\
"Lexing" & p.~\pageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\
"Parsing" & p.~\pageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\
"Stream" & p.~\pageref{Stream} & basic functions over streams \\
\end{tabular}
-\subsubsection{System interface:}
+\subsubsection{sss:stdlib-system}{System interface:}
\begin{tabular}{lll}
"Arg" & p.~\pageref{Arg} & parsing of command line arguments \\
"Callback" & p.~\pageref{Callback} & registering OCaml functions to
"Spacetime" & p.~\pageref{Spacetime} & memory profiler \\
"Sys" & p.~\pageref{Sys} & system interface \\
\end{tabular}
-\subsubsection{Misc:}
+\subsubsection{sss:stdlib-misc}{Misc:}
\begin{tabular}{lll}
"Fun" & p.~\pageref{Fun} & function values \\
\end{tabular}
\item \ahref{libref/Weak.html}{Module \texttt{Weak}: arrays of weak pointers}
\end{links}
\else
+{\ocamldocinputstart
\input{Arg.tex}
\input{Array.tex}
\input{ArrayLabels.tex}
\input{Unit.tex}
\input{Weak.tex}
\input{Ocamloperators.tex}
+}
\fi
+% Section macros with mandatory labels
+% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
+
+% First, we save the normal macros
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsubsection
+% The *-version are distincts macros in hevea
+\let\@oldsection*=\section*
+\let\@oldsubsection*=\subsection*
+\let\@oldsubsubsection*=\subsubsection*
+
+%We go back to standard macros for ocamldoc generated files
+\newcommand{\ocamldocinputstart}{%
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+% The *-version are distincts macros in hevea
+\let\section*=\@oldsection*
+\let\subsection*=\@oldsubsection*
+\let\subsubsection*=\@oldsubsubsection*
+}
+
+\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
+\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
+\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
+\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
+\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+% For paragraph, we do not make labels compulsory
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
+
% Colors for links
+
+\newstyle{a.section-anchor::after}{
+ content:"\@print@u{128279}";
+ font-size:smaller;
+ margin-left:-1.5em;
+ padding-right:0.5em;
+}
+
+
+\newstyle{a.section-anchor}{
+ visibility:hidden;
+ color:grey !important;
+ text-decoration:none !important;
+}
+
+\newstyle{*:hover>a.section-anchor}{
+ visibility:visible;
+}
+
\def\visited@color{\#0d46a3}
\def\link@color{\#4286f4}
-\def\hover@color{\@getstylecolor{subsection}}
\newstyle{a:link}{color:\link@color;text-decoration:underline;}
\newstyle{a:visited}{color:\visited@color;text-decoration:underline;}
-\newstyle{a:hover}{color:black;text-decoration:underline;background-color:\hover@color}
+\newstyle{a:hover}{color:black;text-decoration:underline;}
\newstyle{@media all}{@font-face \{
border-bottom: 1px solid black;
}
-\newstyle{pre}{
+
+\newstyle{div.ocaml}{
+ margin:2ex 0px;
font-size: 1rem;
background: beige;
border: 1px solid grey;
padding: 10px;
overflow-y:auto;
- white-space: pre-wrap;
+ display:flex;
+ flex-direction: column;
+ flex-wrap: nowrap;
+}
+
+\newstyle{div.ocaml .pre}{
+ white-space: pre;
+ font-family:mono;
+}
+
+
+
+\newstyle{.ocamlkeyword}{
+ font-weight:bold;
+}
+
+
+\newstyle{.ocamlhighlight}{
+ font-weight:bold;
+ text-decoration:underline;
+}
+
+\newstyle{.ocamlerror}{
+ font-weight:bold;
+ color:red;
+}
+
+\newstyle{.ocamlwarning}{
+ font-weight:bold;
+ color:purple;
+}
+
+\newstyle{.ocamlcomment}{
+ color:grey;
+}
+
+\newstyle{.ocamlstring}{
+ opacity:0.75;
+}
+
+% Creative commons license logo
+\newstyle{\#cc_license_logo}{
+ float:left;
+ margin-right: 1em;
}
% More spacing between lines and inside tables
%Styles for caml-example and friends
\newstyle{div.caml-output}{color:maroon;}
-\newstyle{div.caml-example pre}{margin:2ex 0px;}
% Styles for toplevel mode only
\newstyle{div.caml-example.toplevel div.caml-input::before}
{content:"\#"; color:black;}
\newstyle{div.caml-example.toplevel div.caml-input}{color:\#006000;}
-%%%
+
+%%% Code examples
\newcommand{\input@color}{\htmlcolor{006000}}
\newcommand{\output@color}{\maroon}
\newcommand{\machine}{\tt}
\newcommand{\nextline}{\examplespace\ }
\newcommand{\@zyva}{\firstline\renewcommand{\?}{\nextline}}
\let\?=\@zyva
-\newenvironment{camlunder}{\@style{U}}{}
-\newcommand{\caml}{\begin{alltt}\renewcommand{\;}{}\renewcommand{\\}{\char92}\def\<{\begin{camlunder}}\def\>{\end{camlunder}}\activebracefalse}
-\newcommand{\endcaml}{\activebracetrue\end{alltt}
-}
\renewcommand{\:}{\renewcommand{\?}{\@zyva}}
\newcommand{\var}[1]{\textit{#1}}
-% Caml-example environment
+%% Caml-example environment
\newcommand{\camlexample}[1]{
\ifthenelse{\equal{#1}{toplevel}}
{\renewcommand{\examplespace}{\ }}
\renewcommand{\examplespace}{\ }
}
-\newcommand{\camlinput}{\@open{div}{class="caml-input"}}
-\newcommand{\endcamlinput}{\@close{div}}
-\newcommand{\camloutput}{\@open{div}{class="caml-output ok"}}
-\newcommand{\endcamloutput}{\@close{div}}
-\newcommand{\camlerror}{\@open{div}{class="caml-output error"}}
-\newcommand{\endcamlerror}{\@close{div}}
-\newcommand{\camlwarn}{\@open{div}{class="caml-output warn"}}
-\newcommand{\endcamlwarn}{\@close{div}}
+\newenvironment{caml}{\@open{div}{class=ocaml}}{\@close{div}}
+\newcommand{\ocamlkeyword}{\@span{class="ocamlkeyword"}}
+\newcommand{\ocamlhighlight}{\@span{class="ocamlhighlight"}}
+\newcommand{\ocamlerror}{\@span{class="ocamlerror"}}
+\newcommand{\ocamlwarning}{\@span{class="ocamlwarning"}}
+\newcommand{\ocamlcomment}{\@span{class="ocamlcomment"}}
+\newcommand{\ocamlstring}{\@span{class="ocamlstring"}}
+
+
+%%% End of code example
\newenvironment{library}{}{}
\newcounter{page}
\newcommand{\vfill}{}
\def\number{}
-\def\year{2019}
+\def\year{\arabic{year}}
% Pour alltt
\def\rminalltt#1{{\rm #1}}
\makeatletter
+
% Pour hevea
\newif\ifouthtml\outhtmlfalse
\newcommand{\cutname}[1]{}
\def\event{$\bowtie$}
\def\fromoneto#1#2{$#1 = 1, \ldots, #2$}
+
+% Redefining sections macros to make label mandatory
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsection
+
+\newcommand{\ocamldocinputstart}{
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+}
+
+\renewcommand{\section}{\@ifstar{\@lsectionstar}{\@lsection}}
+\renewcommand{\subsection}{\@ifstar{\@lsubsectionstar}{\@lsubsection}}
+\renewcommand{\subsubsection}{\@ifstar{\@lsubsubsectionstar}{\@lsubsubsection}}
+
+\newcommand{\@lsection}[2]{\@oldsection{\label{#1}#2}}
+\newcommand{\@lsectionstar}[2]{\@oldsection*{\label{#1}#2}}
+\newcommand{\@lsubsection}[2]{\@oldsubsection{\label{#1}#2}}
+\newcommand{\@lsubsectionstar}[2]{\@oldsubsection*{\label{#1}#2}}
+\newcommand{\@lsubsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\newcommand{\@lsubsubsectionstar}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+\newcommand{\lparagraph}[1]{\paragraph{\label{#1}#1}}
+
% Numerotation
\setcounter{secnumdepth}{2} % Pour numeroter les \subsection
\setcounter{tocdepth}{1} % Pour ne pas mettre les \subsection
\newenvironment{maintitle}{\begin{center}}{\end{center}}
+
+
+% Caml-example related command
+\newenvironment{camlexample}[1]{
+ \ifnum\pdfstrcmp{#1}{toplevel}=0
+ \renewcommand{\hash}{\#}
+ \else
+ \renewcommand{\hash}{}
+ \fi
+}{}
+\newenvironment{caml}{}{}
+\newcommand{\ocamlkeyword}{\bfseries}
+\newcommand{\ocamlhighlight}{\bfseries\uline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+
+\definecolor{gray}{gray}{0.5}
+\newcommand{\ocamlcomment}{\color{gray}\normalfont\small}
+\newcommand{\ocamlstring}{\color{gray}\bfseries}
+
+\newcommand{\?}{\normalsize\tt\hash{} }
+\renewcommand{\:}{\small\ttfamily\slshape}
+
\makeatother
-\input{book.hva}
+\input{anchored_book.hva}
\input{macros.hva}
\newif\ifouthtml\outhtmltrue
\newcommand{\machine}{\tt}
\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
\newenvironment{camlunder}{\@style{U}}{}
-\newcommand{\caml}{\begin{alltt}\renewcommand{\\}{\char92}\def\<{\begin{camlunder}}\def\>{\end{camlunder}}\activebracefalse}
-\newcommand{\endcaml}{\activebracetrue\end{alltt}}
\newcommand{\?}{\black\#\blue }
\renewcommand{\:}{\maroon}
-\def\camlinput{}
-\def\endcamlinput{}
-\def\camloutput{}
-\def\endcamloutput{}
-\def\camlerror{}
-\def\endcamlerror{}
-\def\camlwarn{}
-\def\endcamlwarn{}
+
+\newcommand{\ocamlkeyword}{\bfseries}
+\newcommand{\ocamlhighlight}{\bfseries\underline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+\newcommand{\ocamlcomment}{\normalfont\small}
+\newcommand{\ocamlstring}{\bfseries}
+
+\newenvironment{caml}{\begin{alltt}}{\\\end{alltt}}
+\newenvironment{camlexample}[1]{}{}
+
\newcommand{\var}[1]{\textit{#1}}
\newenvironment{library}{}{}
\newcommand{\nth}[2]{\({#1}_{#2}\)}
\newenvironment{options}{\begin{description}}{\end{description}}
+% Section macros with mandatory labels
+% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
+
+% First, we save the normal macros
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsubsection
+% The *-version are distincts macros in hevea
+\let\@oldsection*=\section*
+\let\@oldsubsection*=\subsection*
+\let\@oldsubsubsection*=\subsubsection*
+
+%We go back to standard macros for ocamldoc generated files
+\newcommand{\ocamldocinputstart}{%
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+% The *-version are distincts macros in hevea
+\let\section*=\@oldsection*
+\let\subsection*=\@oldsubsection*
+\let\subsubsection*=\@oldsubsubsection*
+}
+
+\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
+\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
+\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
+\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
+\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+% For paragraph, we do not make labels compulsory
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
%%venant de macros.tex
\newif\ifouthtml\outhtmlfalse
\usepackage[utf8]{inputenc}
\usepackage[T1]{fontenc}
% HEVEA\@def@charset{UTF-8}%
-\usepackage{alltt}
\usepackage{fullpage}
\usepackage{syntaxdef}
\usepackage{multind}
\usepackage{html}
\usepackage{textcomp}
-\usepackage{caml-sl}
\usepackage{ocamldoc}
\usepackage{xspace}
+\usepackage{color}
+
+% Package for code examples:
+\usepackage{listings}
+\usepackage{alltt}
+\usepackage{lmodern}% for supporting bold ttfamily in code examples
+\usepackage[normalem]{ulem}% for underlining errors in code examples
\input{macros.tex}
+\newcommand{\hash}{\#}
+\lstnewenvironment{camloutput}{
+ \lstset{
+ basicstyle=\small\ttfamily\slshape,
+ showstringspaces=false,
+ language=caml,
+ escapeinside={$}{$},
+ columns=fullflexible,
+ stringstyle=\ocamlstring,
+ keepspaces=true,
+ keywordstyle=\ocamlkeyword,
+ keywords={[2]{val}}, keywordstyle={[2]\ocamlkeyword},
+ aboveskip=0\baselineskip,
+ }
+\ifouthtml
+ \setenvclass{lstlisting}{pre caml-output ok}
+ \lstset {basicstyle=\ttfamily}
+\else
+ \lstset{
+ upquote=true,
+ literate={'"'}{\textquotesingle "\textquotesingle}3
+ {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+}
+\fi
+}{}
+
+\lstnewenvironment{camlinput}{
+ \lstset{
+ basicstyle=\ttfamily,
+ showstringspaces=false,
+ language=caml,
+ escapeinside={$}{$},
+ columns=fullflexible,
+ stringstyle=\ocamlstring,
+ commentstyle=\ocamlcomment,
+ keepspaces=true,
+ keywordstyle=\ocamlkeyword,
+ moredelim=[is][\ocamlhighlight]{<<}{>>},
+ moredelim=[s][\ocamlstring]{\{|}{|\}},
+ moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}},
+ keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword},
+ belowskip=0\baselineskip
+ }
+\ifouthtml
+ \setenvclass{lstlisting}{pre caml-input}
+\else
+%not implemented in hevea: upquote and literate
+ \lstset{
+ upquote=true,
+ literate={'"'}{\textquotesingle "\textquotesingle}3
+ {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+}
+\fi
+}{}
+
+\lstnewenvironment{camlerror}{
+ \lstset{
+ escapeinside={$}{$},
+ showstringspaces=false,
+ basicstyle=\small\ttfamily\slshape,
+ emph={Error}, emphstyle={\ocamlerror},
+ }
+\ifouthtml
+ \setenvclass{lstlisting}{pre caml-output error}
+ \lstset { basicstyle=\ttfamily }
+\else
+\lstset{upquote=true}
+\fi
+}
+{}
+
+\lstnewenvironment{camlwarn}{
+ \lstset{
+ escapeinside={$}{$},
+ showstringspaces=false,
+ basicstyle=\small\ttfamily\slshape,
+ emph={Warning}, emphstyle={\ocamlwarning},
+ }
+\ifouthtml
+\setenvclass{lstlisting}{pre caml-output warn}
+\lstset { basicstyle=\ttfamily }
+\else
+\lstset{upquote=true}
+\fi
+}{}
+
+
% Add meta tag to the generated head tag
\ifouthtml
%\makeatletter \def\@wrindex#1#2{\xdef \@indexfile{\csname #1@idxfile\endcsname}\@@wrindex#2||\\}\makeatother
\def\th{^{\hbox{\scriptsize th}}}
+
\raggedbottom
\input{version.tex}
%HEVEA\tocnumber
%HEVEA\setcounter{cuttingdepth}{1}
%HEVEA\title{The OCaml system, release \ocamlversion}
\input{allfiles.tex}
-
-
-\section{Classes}
+\section{s:classes}{Classes}
%HEVEA\cutname{classes.html}
Classes are defined using a small language, similar to the module
language.
-\subsection{Class types}
+\subsection{ss:classes:class-types}{Class types}
Class types are the class-level equivalent of type expressions: they
specify the general shape and type properties of classes.
\hyperref[s:attributes]{attributes} and
\hyperref[s:extension-nodes]{extension nodes}.
-\subsubsection*{Simple class expressions}
+\subsubsection*{sss:clty:simple}{Simple class expressions}
The expression @classtype-path@ is equivalent to the class type bound to
the name @classtype-path@. Similarly, the expression
type parameters have been instantiated to respectively @typexpr_1@,
\ldots @typexpr_n@.
-\subsubsection*{Class function type}
+\subsubsection*{sss:clty-fun}{Class function type}
The class type expression @typexpr '->' class-type@ is the type of
class functions (functions from values to classes) that take as
argument a value of type @typexpr@ and return as result a class of
type @class-type@.
-\subsubsection*{Class body type}
+\subsubsection*{sss:clty:body}{Class body type}
The class type expression
@'object' ['(' typexpr ')'] {class-field-spec} 'end'@
to forget its implementation. An immutable instance variable will match a
mutable instance variable.
-\subsubsection*{Local opens}
+\subsubsection*{sss:clty-open}{Local opens}
Local opens are supported in class types since OCaml 4.06.
-\subsubsection*{Inheritance}
+\subsubsection*{sss:clty-inheritance}{Inheritance}
\ikwd{inherit\@\texttt{inherit}}
The instance variable and method types from @class-body-type@ are added
into the current class type.
-\subsubsection*{Instance variable specification}
+\subsubsection*{sss:clty-variable}{Instance variable specification}
\ikwd{val\@\texttt{val}}
\ikwd{mutable\@\texttt{mutable}}
An instance variable specification will hide any previous
specification of an instance variable of the same name.
-\subsubsection*{Method specification}
-\label{sec-methspec}
+\subsubsection*{sss:clty-meth}{Method specification}
\ikwd{method\@\texttt{method}}
\ikwd{private\@\texttt{private}}
must have compatible types.
Any non-private specification of a method forces it to be public.
-\subsubsection*{Virtual method specification}
+\subsubsection*{sss:class-virtual-meth-spec}{Virtual method specification}
\ikwd{method\@\texttt{method}}
\ikwd{private\@\texttt{private}}
'virtual' method-name ':' poly-typexpr@, where @method-name@ is the
name of the method and @poly-typexpr@ its expected type.
-\subsubsection*{Constraints on type parameters}
+\subsubsection*{sss:class-constraints}{Constraints on type parameters}
\ikwd{constraint\@\texttt{constraint}}
parameters: in this way, they can be bound to specific type
expressions.
-\subsection{Class expressions}
+\subsection{ss:class-expr}{Class expressions}
Class expressions are the class-level equivalent of value expressions:
they evaluate to classes, thus providing implementations for the
\hyperref[s:attributes]{attributes} and
\hyperref[s:extension-nodes]{extension nodes}.
-\subsubsection*{Simple class expressions}
+\subsubsection*{sss:class-simple}{Simple class expressions}
The expression @class-path@ evaluates to the class bound to the name
@class-path@. Similarly, the expression
@class-expr@, except that all components not specified in
@class-type@ are hidden and can no longer be accessed.
-\subsubsection*{Class application}
+\subsubsection*{sss:class-app}{Class application}
Class application is denoted by juxtaposition of (possibly labeled)
expressions. It denotes the class whose constructor is the first
caused by the application of the constructor will only occur at object
creation time.
-\subsubsection*{Class function}
+\subsubsection*{sss:class-fun}{Class function}
The expression @'fun' [['?']label-name':']pattern '->' class-expr@ evaluates
to a function from values to classes.
@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
\end{center}
-\subsubsection*{Local definitions}
+\subsubsection*{sss:class-localdefs}{Local definitions}
The {\tt let} and {\tt let rec} constructs bind value names locally,
as for the core language expressions.
the definition was outside of the class).
Otherwise, it will be evaluated when the object constructor is called.
-\subsubsection*{Local opens}
+\subsubsection*{sss:class-opens}{Local opens}
Local opens are supported in class expressions since OCaml 4.06.
-\subsubsection*{Class\label{ss:class-body} body}
+\subsubsection*{sss:class-body}{Class body}
\begin{syntax}
class-body: ['(' pattern [':' typexpr] ')'] { class-field }
\end{syntax}
Since OCaml 4.01, it is an error if the same method or instance
variable name is defined several times in the same class body.
-\subsubsection*{Inheritance}
+\subsubsection*{sss:class-inheritance}{Inheritance}
\ikwd{inherit\@\texttt{inherit}}
The scope of this ancestor binding is limited to the current class.
The ancestor method may be called from a subclass but only indirectly.
-\subsubsection*{Instance variable definition}
+\subsubsection*{sss:class-variables}{Instance variable definition}
\ikwd{val\@\texttt{val}}
\ikwd{mutable\@\texttt{mutable}}
omitting it from an interface, it will be kept distinct from
other instance variables with the same name.
-\subsubsection*{Virtual instance variable definition}
+\subsubsection*{sss:class-virtual-variable}{Virtual instance variable definition}
\ikwd{val\@\texttt{val}}
\ikwd{mutable\@\texttt{mutable}}
Virtual instance variables were added in version 3.10.
-\subsubsection*{Method definition}
+\subsubsection*{sss:class-method}{Method definition}
\ikwd{method\@\texttt{method}}
\ikwd{private\@\texttt{private}}
been replaced by the values of the corresponding expressions @expr_1,
\ldots, expr_n@.
-\subsubsection*{Virtual method definition}
+\subsubsection*{sss:class-virtual-meth}{Virtual method definition}
\ikwd{method\@\texttt{method}}
\ikwd{private\@\texttt{private}}
public or private, and gives its type. If the method is intended to be
polymorphic, the type must be explicitly polymorphic.
-\subsubsection*{Explicit overriding}
+\subsubsection*{sss:class-explicit-overriding}{Explicit overriding}
Since Ocaml 3.12, the keywords @"inherit!"@, @"val!"@ and @"method!"@
have the same semantics as @"inherit"@, @"val"@ and @"method"@, but
(method override) and~13 (instance variable override).
Note that warning~7 is disabled by default.
-\subsubsection*{Constraints on type parameters}
+\subsubsection*{sss:class-type-constraints}{Constraints on type parameters}
\ikwd{constraint\@\texttt{constraint}}
The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
parameters: in that way they can be bound to specific type
expressions.
-\subsubsection*{Initializers}
+\subsubsection*{sss:class-initializers}{Initializers}
\ikwd{initializer\@\texttt{initializer}}
will be evaluated whenever an object is created from the class, once
all its instance variables have been initialized.
-\subsection{Class definitions}
+\subsection{ss:class-def}{Class definitions}
\label{s:classdef}
\ikwd{class\@\texttt{class}}
@class-name@ and @'#' class-name@. The first one is the type of
objects of this class, while the second is more general as it unifies
with the type of any object belonging to a subclass (see
-section~\ref{s:sharp-types}).
+section~\ref{sss:typexpr-sharp-types}).
-\subsubsection*{Virtual class}
+\subsubsection*{sss:class-virtual}{Virtual class}
A class must be flagged virtual if one of its methods is virtual (that
is, appears in the class type, but is not actually defined).
Objects cannot be created from a virtual class.
-\subsubsection*{Type parameters}
+\subsubsection*{sss:class-type-params}{Type parameters}
The class type parameters correspond to the ones of the class type and
of the two type abbreviations defined by the class binding. They must
variables of the inferred type of the class must either be type
parameters or be bound in the constraint clause.
-\subsection{Class specifications}
-\label{s:class-spec}
+\subsection{ss:class-spec}{Class specifications}
\ikwd{class\@\texttt{class}}
\ikwd{and\@\texttt{and}}
A class specification matches a class definition if they have the same
type parameters and their types match.
-\subsection{Class type definitions}
-\label{s:classtype}
+\subsection{ss:classtype}{Class type definitions}
\ikwd{class\@\texttt{class}}
\ikwd{type\@\texttt{type}}
-\section{Compilation units}
+\section{s:compilation-units}{Compilation units}
%HEVEA\cutname{compunit.html}
\begin{syntax}
-\section{Constants}
+\section{s:const}{Constants}
%HEVEA\cutname{const.html}
\ikwd{false\@\texttt{false}}
| "`"tag-name
\end{syntax}
See also the following language extension:
-\hyperref[s:extension-literals]{extension literals}.
+\hyperref[ss:extension-literals]{extension literals}.
The syntactic class of constants comprises literals from the four
base types (integers, floating-point numbers, characters, character
-\section{Expressions\label{s:value-expr}}
+\section{s:value-expr}{Expressions}
%HEVEA\cutname{expr.html}
\ikwd{in\@\texttt{in}|see{\texttt{let}}}
\ikwd{and\@\texttt{and}}
| '?' label-name ':' '(' pattern [':' typexpr] ['=' expr] ')'
\end{syntax}
See also the following language extensions:
-\hyperref[s-first-class-modules]{first-class modules},
+\hyperref[s:first-class-modules]{first-class modules},
\hyperref[s:explicit-overriding-open]{overriding in open statements},
\hyperref[s:bigarray-access]{syntax for Bigarray access},
\hyperref[s:attributes]{attributes},
\hyperref[s:extension-nodes]{extension nodes} and
\hyperref[s:index-operators]{extended indexing operators}.
-\subsection{Precedence and associativity}
+\subsection{ss:precedence-and-associativity}{Precedence and associativity}
The table below shows the relative precedences and associativity of
operators and non-closed constructions. The constructions with higher
precedence come first. For infix and prefix symbols, we write
\entree{"let match fun function try"}{--}
\end{tableau}
-\subsection{Basic expressions}
+\subsection{ss:expr-basic}{Basic expressions}
-\subsubsection*{Constants}
+\subsubsection*{sss:expr-constants}{Constants}
An expression consisting in a constant evaluates to this constant.
-\subsubsection*{Value paths} \label{expr:var}
+\subsubsection*{sss:expr-var}{Value paths}
An expression consisting in an access path evaluates to the value bound to
this path in the current evaluation environment. The path can
be either a value name or an access path to a value component of a module.
-\subsubsection*{Parenthesized expressions}
+\subsubsection*{sss:expr-parenthesized}{Parenthesized expressions}
\ikwd{begin\@\texttt{begin}}
\ikwd{end\@\texttt{end}}
Parenthesized expressions can also contain coercions
@'(' expr [':' typexpr] ':>' typexpr')'@ (see
-subsection~\ref{s:coercions} below).
+subsection~\ref{ss:expr-coercions} below).
-\subsubsection*{Function application}
+\subsubsection*{sss:expr-functions-application}{Function application}
Function application is denoted by juxtaposition of (possibly labeled)
expressions. The expression @expr argument_1 \ldots argument_n@
point. This can be ensured by adding a type constraint. Principality
of the derivation can be checked in the "-principal" mode.
-\subsubsection*{Function definition}
+\subsubsection*{sss:expr-function-definition}{Function definition}
Two syntactic forms are provided to define functions. The first form
is introduced by the keyword "function":
an environment enriched by the bindings performed during the matchings.
If the matching fails, the exception "Match_failure" is raised.
-\subsubsection*{Guards in pattern-matchings}
+\subsubsection*{sss:guards-in-pattern-matchings}{Guards in pattern-matchings}
\ikwd{when\@\texttt{when}}
The cases of a pattern matching (in the @"function"@, @"match"@ and
matching, as usual. But if @@cond@_i@ evaluates to "false", the matching
is resumed against the patterns following @pattern_i@.
-\subsubsection*{Local definitions} \label{s:localdef}
+\subsubsection*{sss:expr-localdef}{Local definitions}
\ikwd{let\@\texttt{let}}
implementation-dependent. The current implementation also supports
a certain class of recursive definitions of non-functional values,
as explained in section~\ref{s:letrecvalues}.
-\subsubsection{Explicit polymorphic type annotations}
+\subsubsection{sss:expr-explicit-polytype}{Explicit polymorphic type annotations}
(Introduced in OCaml 3.12)
Polymorphic type annotations in @"let"@-definitions behave in a way
let () = assert(gen () <> gen ())
\end{verbatim}
-\subsection{Control structures}
+\subsection{ss:expr-control}{Control structures}
-\subsubsection*{Sequence}
+\subsubsection*{sss:expr-sequence}{Sequence}
The expression @expr_1 ";" expr_2@ evaluates @expr_1@ first, then
@expr_2@, and returns the value of @expr_2@.
-\subsubsection*{Conditional}
+\subsubsection*{sss:expr-conditional}{Conditional}
\ikwd{if\@\texttt{if}}
The expression @"if" expr_1 "then" expr_2 "else" expr_3@ evaluates to
The @"else" expr_3@ part can be omitted, in which case it defaults to
@"else" "()"@.
-\subsubsection*{Case expression}\ikwd{match\@\texttt{match}}
+\subsubsection*{sss:expr-case}{Case expression}\ikwd{match\@\texttt{match}}
The expression
$$\begin{array}{rlll}
%
\index{Matchfailure\@\verb`Match_failure`}
-\subsubsection*{Boolean operators}
+\subsubsection*{sss:expr-boolean-operators}{Boolean operators}
The expression @expr_1 '&&' expr_2@ evaluates to @'true'@ if both
@expr_1@ and @expr_2@ evaluate to @'true'@; otherwise, it evaluates to
The boolean operators @'&'@ and @'or'@ are deprecated synonyms for
(respectively) @'&&'@ and @'||'@.
-\subsubsection*{Loops}
+\subsubsection*{sss:expr-loops}{Loops}
\ikwd{while\@\texttt{while}}
The expression @'while' expr_1 'do' expr_2 'done'@ repeatedly
In both cases, the whole @'for'@ expression evaluates to the unit
value @'()'@.
-\subsubsection*{Exception handling}
+\subsubsection*{sss:expr-exception-handling}{Exception handling}
\ikwd{try\@\texttt{try}}
The expression
exception value is raised again, thereby transparently ``passing
through'' the @'try'@ construct.
-\subsection{Operations on data structures}
+\subsection{ss:expr-ops-on-data}{Operations on data structures}
-\subsubsection*{Products}
+\subsubsection*{sss:expr-products}{Products}
The expression @expr_1 ',' \ldots ',' expr_n@ evaluates to the
\var{n}-tuple of the values of expressions @expr_1@ to @expr_n@. The
evaluation order of the subexpressions is not specified.
-\subsubsection*{Variants}
+\subsubsection*{sss:expr-variants}{Variants}
The expression @constr expr@ evaluates to the unary variant value
whose constructor is @constr@, and whose argument is the value of
'[]'@, and therefore evaluates to the list whose elements are the
values of @expr_1@ to @expr_n@.
-\subsubsection*{Polymorphic variants}
+\subsubsection*{sss:expr-polyvars}{Polymorphic variants}
The expression @"`"tag-name expr@ evaluates to the polymorphic variant
value whose tag is @tag-name@, and whose argument is the value of @expr@.
-\subsubsection*{Records}
+\subsubsection*{sss:expr-records}{Records}
The expression @'{' field_1 ['=' expr_1] ';' \ldots ';' field_n ['='
expr_n ']}'@ evaluates to the record value
expression @expr_1 '.' field '<-' expr_2@ evaluates to the unit value
@'()'@.
-\subsubsection*{Arrays}
+\subsubsection*{sss:expr-arrays}{Arrays}
The expression @'[|' expr_1 ';' \ldots ';' expr_n '|]'@ evaluates to
a \var{n}-element array, whose elements are initialized with the values of
the value of @expr_3@. The exception "Invalid_argument" is raised if
the access is out of bounds. The value of the whole expression is @'()'@.
-\subsubsection*{Strings}
+\subsubsection*{sss:expr-strings}{Strings}
The expression @expr_1 '.[' expr_2 ']'@ returns the value of character
number @expr_2@ in the string denoted by @expr_1@. The first character
future version. New code should use byte sequences and the "Bytes.set"
function.
-\subsection{Operators}
+\subsection{ss:expr-operators}{Operators}
\ikwd{mod\@\texttt{mod}}
\ikwd{land\@\texttt{land}}
\ikwd{lor\@\texttt{lor}}
\entree{"|| or"}{Boolean disjunction.}
\end{tableau}
-\subsection{Objects} \label{s:objects}
+\subsection{ss:expr-obj}{Objects} \label{s:objects}
-\subsubsection*{Object creation}
+\subsubsection*{sss:expr-obj-creation}{Object creation}
\ikwd{new\@\texttt{new}}
evaluates to a function expecting the same number of arguments and
returning a new object of this class.
-\subsubsection*{Immediate object creation}
+\subsubsection*{sss:expr-obj-immediate}{Immediate object creation}
\ikwd{object\@\texttt{object}}
Creating directly an object through the @'object' class-body 'end'@
construct is operationally equivalent to defining locally a @'class'
class-name '=' 'object' class-body 'end'@ ---see sections
-\ref{ss:class-body} and following for the syntax of @class-body@---
+\ref{sss:class-body} and following for the syntax of @class-body@---
and immediately creating a single object from it by @'new' class-name@.
The typing of immediate objects is slightly different from explicitly
immediate object will never be extended, its self type can be unified
with a closed object type.
-\subsubsection*{Method invocation}
+\subsubsection*{sss:expr-method}{Method invocation}
The expression @expr '#' method-name@ invokes the method
@method-name@ of the object denoted by @expr@.
there is a type constraint. Principality of the derivation can be
checked in the "-principal" mode.
-\subsubsection*{Accessing and modifying instance variables}
+\subsubsection*{sss:expr-obj-variables}{Accessing and modifying instance variables}
The instance variables of a class are visible only in the body of the
methods defined in the same class or a class that inherits from the
@inst-var-name '<-' expr@ evaluates to @"()"@.
-\subsubsection*{Object duplication}
+\subsubsection*{sss:expr-obj-duplication}{Object duplication}
An object can be duplicated using the library function "Oo.copy"
(see module \stdmoduleref{Oo}). Inside a method, the expression
name @id@ stands for @id '=' id@. Other instance variables have the same
value in the returned object as in self.
-\subsection{Coercions} \label{s:coercions}
+\subsection{ss:expr-coercions}{Coercions}
Expressions whose type contains object or polymorphic variant types
can be explicitly coerced (weakened) to a supertype.
%
In the following paragraphs we describe the subtyping relation used.
-\subsubsection*{Object types}
+\subsubsection*{sss:expr-obj-types}{Object types}
A fixed object type admits as subtype any object type that includes all
its methods. The types of the methods shall be subtypes of those in
appear in a contravariant position in the class type, {\em i.e.} if
there are no binary methods.
-\subsubsection*{Polymorphic variant types}
+\subsubsection*{sss:expr-polyvar-types}{Polymorphic variant types}
A polymorphic variant type @typ@ is a subtype of another polymorphic
variant type @typ@$'$ if the upper bound of @typ@ ({\em i.e.} the
\end{center}
which may be an extensible type, if every @typ_i@ is a subtype of @typ@$'_i$.
-\subsubsection*{Variance}
+\subsubsection*{sss:expr-variance}{Variance}
Other types do not introduce new subtyping, but they may propagate the
subtyping of their arguments. For instance, @typ_1 "*" typ_2@ is a
not have to be a subtype or a supertype.
%
For abstract and private types, the variance must be given explicitly
-(see section~\ref{s:type-defs}),
+(see section~\ref{ss:typedefs}),
otherwise the default is nonvariant. This is also the case for
constrained arguments in type definitions.
-\subsection{Other}
+\subsection{ss:expr-other}{Other}
-\subsubsection*{Assertion checking}
+\subsubsection*{sss:expr-assertion}{Assertion checking}
\ikwd{assert\@\texttt{assert}}
%
\index{Assertfailure\@\verb`Assert_failure`}
-\subsubsection*{Lazy expressions}
+\subsubsection*{sss:expr-lazy}{Lazy expressions}
\ikwd{lazy\@\texttt{lazy}}
The expression @"lazy" expr@ returns a value \var{v} of type "Lazy.t" that
be performed the first time the function "Lazy.force" is applied to the value
\var{v}, returning the actual value of @expr@. Subsequent applications
of "Lazy.force" to \var{v} do not evaluate @expr@ again. Applications
-of "Lazy.force" may be implicit through pattern matching (see~\ref{s:lazypat}).
+of "Lazy.force" may be implicit through pattern matching (see~\ref{sss:pat-lazy}).
-\subsubsection*{Local modules}
+\subsubsection*{sss:expr-local-modules}{Local modules}
\ikwd{let\@\texttt{let}}
\ikwd{module\@\texttt{module}}
(List.fold_right StringSet.add string_list StringSet.empty)
\end{caml_example}
-\subsubsection*{Local opens}
+\subsubsection*{sss:local-opens}{Local opens}
\ikwd{let\@\texttt{let}}
\ikwd{module\@\texttt{open}}
%HEVEA\cutdef{section}
-\section{Recursive definitions of values} \label{s:letrecvalues}
+\section{s:letrecvalues}{Recursive definitions of values}
+%HEVEA\cutname{letrecvalues.html}
(Introduced in Objective Caml 1.00)
-As mentioned in section~\ref{s:localdef}, the @'let' 'rec'@ binding
+As mentioned in section~\ref{sss:expr-localdef}, the @'let' 'rec'@ binding
construct, in addition to the definition of recursive functions,
also supports a certain class of recursive definitions of
non-functional values, such as
is immediately linked to @name@.
\end{itemize}
-\section{Recursive modules} \label{s-recursive-modules}
+\section{s:recursive-modules}{Recursive modules}
\ikwd{module\@\texttt{module}}
\ikwd{and\@\texttt{and}}
Note that, in the @specification@ case, the @module-type@s must be
parenthesized if they use the @'with' mod-constraint@ construct.
-\section{Private types}\label{s:private-types}
+\section{s:private-types}{Private types}
+%HEVEA\cutname{privatetypes.html}
\ikwd{private\@\texttt{private}}
Private type declarations in module signatures, of the form
on the type implementation, and data type definitions and type
abbreviations, where all aspects of the type implementation are
publicized. Private type declarations come in three flavors: for
-variant and record types (section~\ref{s-private-types-variant}),
-for type abbreviations (section~\ref{s-private-types-abbrev}),
-and for row types (section~\ref{s-private-rows}).
+variant and record types (section~\ref{ss:private-types-variant}),
+for type abbreviations (section~\ref{ss:private-types-abbrev}),
+and for row types (section~\ref{ss:private-rows}).
+
+\subsection{ss:private-types-variant}{Private variant and record types}
-\subsection{Private variant and record types} \label{s-private-types-variant}
(Introduced in Objective Caml 3.07)
parameters, their variance is the one explicitly given by prefixing
the parameter by a `"+"' or a `"-"', it is invariant otherwise.
-\subsection{Private type abbreviations} \label{s-private-types-abbrev}
+\subsection{ss:private-types-abbrev}{Private type abbreviations}
(Introduced in Objective Caml 3.11)
@typexpr_1@ is the expected type of @expr@. Concretely, this would be "(x :
N.t :> int)" and "(l : N.t list :> int list)" for the above examples.
-\subsection{Private row types} \label{s-private-rows}
+\subsection{ss:private-rows}{Private row types}
\ikwd{private\@\texttt{private}}
(Introduced in Objective Caml 3.09)
Similarly to abstract types, the variance of type parameters
is not inferred, and must be given explicitly.
-
-\section{Local opens for patterns}
-\ikwd{let\@\texttt{let}}
-\ikwd{open\@\texttt{open}} \label{s:local-opens}
-
-(Introduced in OCaml 4.04)
-
-\begin{syntax}
-pattern:
- ...
- | module-path '.(' pattern ')'
- | module-path '.[' pattern ']'
- | module-path '.[|' pattern '|]'
- | module-path '.{' pattern '}'
-
-\end{syntax}
-
-For patterns, local opens are limited to the
-@module-path'.('pattern')'@ construction. This
-construction locally open the module referred to by the module path
-@module-path@ in the scope of the pattern @pattern@.
-
-When the body of a local open pattern is delimited by
-@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted.
-For example, @module-path'.['pattern']'@ is equivalent to
-@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is
-equivalent to @module-path'.([|' pattern '|])'@.
-
-\section{Locally abstract types}
+\section{s:locally-abstract}{Locally abstract types}
\ikwd{type\@\texttt{type}}
-\ikwd{fun\@\texttt{fun}} \label{s:locally-abstract}
+\ikwd{fun\@\texttt{fun}}
+%HEVEA\cutname{locallyabstract.html}
+
(Introduced in OCaml 3.12, short syntax added in 4.03)
\end{caml_example*}
It is also extremely useful for first-class modules (see
-section~\ref{s-first-class-modules}) and generalized algebraic datatypes
+section~\ref{s:first-class-modules}) and generalized algebraic datatypes
(GADTs: see section~\ref{s:gadts}).
-\paragraph{Polymorphic syntax} (Introduced in OCaml 4.00)
+\lparagraph{p:polymorpic-locally-abstract}{Polymorphic syntax} (Introduced in OCaml 4.00)
\begin{syntax}
let-binding:
The same feature is provided for method definitions.
-\section{First-class modules}\label{s-first-class-modules}
+\section{s:first-class-modules}{First-class modules}
\ikwd{module\@\texttt{module}}
\ikwd{val\@\texttt{val}}
\ikwd{with\@\texttt{with}}
\ikwd{and\@\texttt{and}}
+%HEVEA\cutname{firstclassmodules.html}
+
(Introduced in OCaml 3.12; pattern syntax and package type inference
introduced in 4.00; structural comparison of package types introduced in 4.02.;
@'let' 'module' module-name '=' '(' "val" expr_1 ":" package-type ')'
"in" expr_2@.
-\paragraph{Basic example} A typical use of first-class modules is to
+\lparagraph{p:fst-mod-example}{Basic example} A typical use of first-class modules is to
select at run-time among several implementations of a signature.
Each implementation is a structure that we can encapsulate as a
first-class module, then store in a data structure such as a hash
let _ = Hashtbl.add devices "SVG" (module SVG : DEVICE)
module PDF = struct let draw () = () [@@ellipsis] end
-let _ = Hashtbl.add devices "PDF" (module PDF: DEVICE)
+let _ = Hashtbl.add devices "PDF" (module PDF : DEVICE)
\end{caml_example*}
We can then select one implementation based on command-line
Device.draw picture
\end{caml_example*}
-\paragraph{Advanced examples}
+\lparagraph{p:fst-mod-advexamples}{Advanced examples}
With first-class modules, it is possible to parametrize some code over the
implementation of a module without using a functor.
polymorphic recursion.
\fi
-\section{Recovering the type of a module} \label{s:module-type-of}
+\section{s:module-type-of}{Recovering the type of a module}
+%HEVEA\cutname{moduletypeof.html}
\ikwd{module\@\texttt{module}}
\ikwd{type\@\texttt{type}}
This idiom guarantees that "Myset" is compatible with Set, but allows
it to represent sets internally in a different way.
-\section{Substituting inside a signature}
+\section{s:signature-substitution}{Substituting inside a signature}
\ikwd{with\@\texttt{with}}
\ikwd{module\@\texttt{module}}
\ikwd{type\@\texttt{type}}
-\label{s:signature-substitution}
+%HEVEA\cutname{signaturesubstitution.html}
-\subsection{Destructive substitutions}
-\label{ss:destructive-substitution}
+
+\subsection{ss:destructive-substitution}{Destructive substitutions}
(Introduced in OCaml 3.12, generalized in 4.06)
module type CompareInt = ComparableInt with type t := int
\end{caml_example}
-\subsection{Local substitution declarations}
-\label{ss:local-substitution}
+\subsection{ss:local-substitution}{Local substitution declarations}
(Introduced in OCaml 4.08)
end [@@expect error];;
\end{caml_example}
-\section{Type-level module aliases}
+\section{s:module-alias}{Type-level module aliases}
\ikwd{module\@\texttt{module}}
-\label{s:module-alias}
+%HEVEA\cutname{modulealias.html}
(Introduced in OCaml 4.02)
module N = P
\end{caml_example*}
has type
-\caml
-\:module N = P
-\endcaml
+\begin{caml_example*}{signature}
+module N = P
+\end{caml_example*}
Type-level module aliases are used when checking module path
equalities. That is, in a context where module name @N@ is known to be
all the user sees is the nicer dot names. This is how the OCaml
standard library is compiled.
-\section{Overriding in open statements}\label{s:explicit-overriding-open}
+\section{s:explicit-overriding-open}{Overriding in open statements}
\ikwd{open.\@\texttt{open\char33}}
+%HEVEA\cutname{overridingopen.html}
(Introduced in OCaml 4.01)
This is also available (since OCaml 4.06) for local opens in class
expressions and class type expressions.
-\section{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}}
-\ikwd{match\@\texttt{match}} \label{s:gadts}
+\section{s:gadts}{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}}
+\ikwd{match\@\texttt{match}}
+%HEVEA\cutname{gadts.html}
+
(Introduced in OCaml 4.00)
abstract types are generated, and they must not escape the
scope of this branch.
-\paragraph{Recursive functions}
+\lparagraph{p:gadts-recfun}{Recursive functions}
Here is a concrete example:
\begin{caml_example*}{verbatim}
flow to the type variable "'a" and escape its scope. This triggers the
above error.
-\paragraph{Type inference}
+\lparagraph{p:gadts-type-inference}{Type inference}
Type inference for GADTs is notoriously hard.
This is due to the fact some types may become ambiguous when escaping
\end{caml_example*}
-\paragraph{Refutation cases} (Introduced in OCaml 4.03)
+\lparagraph{p:gadt-refutation-cases}{Refutation cases} (Introduced in OCaml 4.03)
Usually, the exhaustiveness check only tries to check whether the
cases omitted from the pattern matching are typable or not.
case will be detected as redundant if it could be replaced by a
refutation case using the same pattern.
-\paragraph{Advanced examples}
+\lparagraph{p:gadts-advexamples}{Advanced examples}
The "term" type we have defined above is an {\em indexed} type, where
a type parameter reflects a property of the value contents.
Another use of GADTs is {\em singleton} types, where a GADT value
| Some Eq -> Some x
\end{caml_example*}
-\paragraph{Existential type names in error messages}%
-\label{p:existential-names}
+\lparagraph{p:existential-names}{Existential type names in error messages}%
(Updated in OCaml 4.03.0)
The typing of pattern matching in presence of GADT can generate many
As shown by the last item, the current behavior is imperfect
and may be improved in future versions.
-\paragraph{Equations on non-local abstract types} (Introduced in OCaml
+\lparagraph{p:gadt-equation-nonlocal-abstract}{Equations on non-local abstract types} (Introduced in OCaml
4.04)
GADT pattern-matching may also add type equations to non-local
abstract types defined by the local module, are non-instantiable, and
as such cause a type error rather than introduce an equation.
-\section{Syntax for Bigarray access}\label{s:bigarray-access}
+\section{s:bigarray-access}{Syntax for Bigarray access}
+%HEVEA\cutname{bigarray.html}
(Introduced in Objective Caml 3.00)
The last two entries are valid for any $n > 3$.
-\section{Attributes}\label{s:attributes}
+\section{s:attributes}{Attributes}
+%HEVEA\cutname{attributes.html}
\ikwd{when\@\texttt{when}}
\end{verbatim}
-\subsection{Built-in attributes}
-\label{ss:builtin-attributes}
+\subsection{ss:builtin-attributes}{Built-in attributes}
Some attributes are understood by the type-checker:
\begin{itemize}
enumerated types). Mutation of these immediate types does not activate the
garbage collector's write barrier, which can significantly boost performance in
programs relying heavily on mutable state.
+\item
+ ``ocaml.immediate64'' or ``immediate64'' applied on an abstract type mark the
+ type as having a non-pointer implementation on 64 bit platforms. No assumption
+ is made on other platforms. In order to produce a type with the
+ ``immediate64`` attribute, one must use ``Sys.Immediate64.Make`` functor.
\item
"ocaml.unboxed" or "unboxed" can be used on a type definition if the
type is a single-field record or a concrete type with a single
end
\end{caml_example*}
+\begin{caml_example*}{verbatim}
+module Int_or_int64 : sig
+ type t [@@immediate64]
+ val zero : t
+ val one : t
+ val add : t -> t -> t
+end = struct
+
+ include Sys.Immediate64.Make(Int)(Int64)
+
+ module type S = sig
+ val zero : t
+ val one : t
+ val add : t -> t -> t
+ end
-\section{Extension nodes}\label{s:extension-nodes}
+ let impl : (module S) =
+ match repr with
+ | Immediate ->
+ (module Int : S)
+ | Non_immediate ->
+ (module Int64 : S)
+
+ include (val impl : S)
+end
+\end{caml_example*}
+
+\section{s:extension-nodes}{Extension nodes}
+%HEVEA\cutname{extensionnodes.html}
(Introduced in OCaml 4.02,
infix notations for constructs other than expressions added in 4.03,
specific delimiter limits the freedom to change the delimiter to avoid
escaping issues.
-\subsection{Built-in extension nodes}
+\subsection{ss:builtin-extension-nodes}{Built-in extension nodes}
(Introduced in OCaml 4.03)
x <> y;;
\end{caml_example}
-\section{Extensible variant types}\label{s:extensible-variants}
+\section{s:extensible-variants}{Extensible variant types}
+%HEVEA\cutname{extensiblevariants.html}
(Introduced in OCaml 4.02)
let construction_is_forbidden = B.Bool 1;;
\end{caml_example}
-\subsection{Private extensible variant types}
+\subsection{ss:private-extensible}{Private extensible variant types}
(Introduced in OCaml 4.06)
end
\end{caml_example*}
-\section{Generative functors}\label{s:generative-functors}
+\section{s:generative-functors}{Generative functors}
+%HEVEA\cutname{generativefunctors.html}
(Introduced in OCaml 4.02)
As a side-effect of this generativity, one is allowed to unpack
first-class modules in the body of generative functors.
-\section{Extension-only syntax}
+\section{s:extension-syntax}{Extension-only syntax}
+%HEVEA\cutname{extensionsyntax.html}
(Introduced in OCaml 4.02.2, extended in 4.03)
Some syntactic constructions are accepted during parsing and rejected
external tools can exploit this parser leniency to extend the language
with these new syntactic constructions by rewriting them to
vanilla constructions.
-\subsection{Extension operators} \label{s:ext-ops}
+\subsection{ss:extension-operators}{Extension operators} \label{s:ext-ops}
(Introduced in OCaml 4.02.2)
\begin{syntax}
infix-symbol:
Operator names starting with a "#" character and containing more than
one "#" character are reserved for extensions.
-\subsection{Extension literals} \label{s:extension-literals}
+\subsection{ss:extension-literals}{Extension literals}
(Introduced in OCaml 4.03)
\begin{syntax}
float-literal:
Int and float literals followed by an one-letter identifier in the
range @["g".."z"||"G".."Z"]@ are extension-only literals.
-\section{Inline records} \label{s:inline-records}
+\section{s:inline-records}{Inline records}
+%HEVEA\cutname{inlinerecords.html}
(Introduced in OCaml 4.03)
\begin{syntax}
constr-args:
| Point p -> p
\end{caml_example}
-\section{Documentation comments}
+\section{s:doc-comments}{Documentation comments}
+%HEVEA\cutname{doccomments.html}
(Introduced in OCaml 4.03)
Comments which start with "**" are treated specially by the
recognised by the compiler are a subset of the forms accepted by
ocamldoc (see \ref{s:ocamldoc-comments}).
-\subsection{Floating comments}
+\subsection{ss:floating-comments}{Floating comments}
Comments surrounded by blank lines that appear within structures,
signatures, classes or class types are converted into
let mkT = T
\end{caml_example*}
-\subsection{Item comments}
+\subsection{ss:item-comments}{Item comments}
Comments which appear {\em immediately before} or {\em immediately
after} a structure item, signature item, class item or class type item
and the compiler will emit warning 50.
-\subsection{Label comments}
+\subsection{ss:label-comments}{Label comments}
Comments which appear {\em immediately after} a labelled argument,
record field, variant constructor, object method or polymorphic variant
[@@ocaml.doc " Attaches to t "]
\end{caml_example*}
-\section{Extended indexing operators \label{s:index-operators} }
+\section{s:index-operators}{Extended indexing operators }
+%HEVEA\cutname{indexops.html}
(Introduced in 4.06)
\begin{syntax}
dot-ext:
- | ('!'||'$'||'%'||'&'||'*'||'+'||'-'||'/'||':'||'='||'>'||'?'||'@'||'^'||'|'||'~') { operator-char }
+ | dot-operator-char { operator-char }
+;
+dot-operator-char:
+ '!' || '?' || core-operator-char || '%' || ':'
;
expr:
...
let open Dict in dict.%{"two"};;
\end{caml_example}
-\section{Empty variant types\label{s:empty-variants} }
+\subsection{ss:multiindexing}{Multi-index notation}
+\begin{syntax}
+expr:
+ ...
+ | expr '.' [module-path '.'] dot-ext '(' expr {{';' expr }} ')' [ '<-' expr ]
+ | expr '.' [module-path '.'] dot-ext '[' expr {{';' expr }} ']' [ '<-' expr ]
+ | expr '.' [module-path '.'] dot-ext '{' expr {{';' expr }} '}' [ '<-' expr ]
+;
+operator-name:
+ ...
+ | '.' dot-ext ('(;..)' || '[;..]' || '{;..}') ['<-']
+;
+\end{syntax}
+
+Multi-index are also supported through a second variant of indexing operators
+
+\begin{caml_example*}{verbatim}
+let (.%[;..]) = Bigarray.Genarray.get
+let (.%{;..}) = Bigarray.Genarray.get
+let (.%(;..)) = Bigarray.Genarray.get
+\end{caml_example*}
+
+which is called when an index literals contain a semicolon separated list
+of expressions with two and more elements:
+
+\begin{caml_example*}{verbatim}
+let sum x y = x.%[1;2;3] + y.%[1;2]
+(* is equivalent to *)
+let sum x y = (.%[;..]) x [|1;2;3|] + (.%[;..]) y [|1;2|]
+\end{caml_example*}
+
+In particular this multi-index notation makes it possible to uniformly handle
+indexing Genarray and other implementations of multidimensional arrays.
+
+\begin{caml_example*}{verbatim}
+module A = Bigarray.Genarray
+let (.%{;..}) = A.get
+let (.%{;..}<- ) = A.set
+let (.%{ }) a k = A.get a [|k|]
+let (.%{ }<-) a k x = A.set a [|k|] x
+let syntax_compare vec mat t3 t4 =
+ vec.%{0} = A.get vec [|0|]
+ && mat.%{0;0} = A.get mat [|0;0|]
+ && t3.%{0;0;0} = A.get t3 [|0;0;0|]
+ && t4.%{0;0;0;0} = t4.{0,0,0,0}
+\end{caml_example*}
+
+
+
+\section{s:empty-variants}{Empty variant types}
+%HEVEA\cutname{emptyvariants.html}
(Introduced in 4.07.0)
\begin{syntax}
let f (x: t) = match x with _ -> .
\end{caml_example*}
-\section{Alerts \label{s:alerts} }
+\section{s:alerts}{Alerts}
+%HEVEA\cutname{alerts.html}
(Introduced in 4.08)
Since OCaml 4.08, it is possible to mark components (such as value or
[@@@ocaml.alert deprecated "Please do something else"]
\end{verbatim}
-\section{Generalized open statements\label{s:generalized-open}}
+\section{s:generalized-open}{Generalized open statements}
+%HEVEA\cutname{generalizedopens.html}
(Introduced in 4.08)
...
\end{verbatim}
-\section{Binding operators\label{s:binding-operators} }
+\section{s:binding-operators}{Binding operators}
+%HEVEA\cutname{bindingops.html}
(Introduced in 4.08.0)
\begin{syntax}
let-operator:
- | 'let' ('$'||'&'||'*'||'+'||'-'||'/'||'<'||'='||'>'||'@'||'^'||'|') { operator-char }
+ | 'let' (core-operator-char || '<') { dot-operator-char }
;
and-operator:
- | 'and' ('$'||'&'||'*'||'+'||'-'||'/'||'<'||'='||'>'||'@'||'^'||'|') { operator-char }
+ | 'and' (core-operator-char || '<') { dot-operator-char }
;
operator-name :
...
(fun ((x1, x2), x3) -> x1 + x2 + x3)
\end{caml_example}
-\subsection{Rationale}
+\subsection{ss:letops-rationale}{Rationale}
This extension is intended to provide a convenient syntax for working
with monads and applicatives.
-\section{Lexical conventions}
+\section{s:lexical-conventions}{Lexical conventions}
%HEVEA\cutname{lex.html}
-\subsubsection*{Blanks}
+\subsubsection*{sss:lex:blanks}{Blanks}
The following characters are considered as blanks: space,
horizontal tabulation, carriage return, line feed and form feed. Blanks are
keywords that would otherwise be confused as one single identifier,
literal or keyword.
-\subsubsection*{Comments}
+\subsubsection*{sss:lex:comments}{Comments}
Comments are introduced by the two characters @"(*"@, with no
intervening blanks, and terminated by the characters @"*)"@, with
Comments do not occur inside string or character literals. Nested
comments are handled correctly.
-\subsubsection*{Identifiers}
+\subsubsection*{sss:lex:identifiers}{Identifiers}
\begin{syntax}
ident: ( letter || "_" ) { letter || "0" \ldots "9" || "_" || "'" } ;
underscore character is considered a lowercase letter for this
purpose.
-\subsubsection*{Integer literals}
+\subsubsection*{sss:integer-literals}{Integer literals}
\begin{syntax}
integer-literal:
For convenience and readability, underscore characters (@"_"@) are accepted
(and ignored) within integer literals.
-\subsubsection*{Floating-point literals}
+\subsubsection*{sss:floating-point-literals}{Floating-point literals}
\begin{syntax}
float-literal:
For convenience and readability, underscore characters (@"_"@) are accepted
(and ignored) within floating-point literals.
-\subsubsection*{Character literals}
+\subsubsection*{sss:character-literals}{Character literals}
\label{s:characterliteral}
\begin{syntax}
\entree{"\\o"\var{ooo}}{the character with ASCII code \var{ooo} in octal}
\end{tableau}
-\subsubsection*{String literals}
-\label{s:stringliteral}
+\subsubsection*{sss:stringliterals}{String literals}
\begin{syntax}
string-literal:
The current implementation places practically no restrictions on the
length of string literals.
-\subsubsection*{Naming labels}
-\label{s:labelname}
+\subsubsection*{sss:labelname}{Naming labels}
To avoid ambiguities, naming labels in expressions cannot just be defined
syntactically as the sequence of the three tokens "~", @ident@ and
type expressions, this expansion can be taken literally, {\em i.e.}
there are really 3 tokens, with optional blanks between them.
-\subsubsection*{Prefix and infix symbols}
+\subsubsection*{sss:lex-ops-symbols}{Prefix and infix symbols}
%% || '`' lowercase-ident '`'
\begin{syntax}
infix-symbol:
- ('=' || '<' || '>' || '@' || '^' || '|' || '&' ||
- '+' || '-' || '*' || '/' || '$' || '%') { operator-char }
+ ( core-operator-char || '%' || '<' ) { operator-char }
| "#" {{ operator-char }}
;
prefix-symbol:
| ('?' || '~') {{ operator-char }}
;
operator-char:
- '!' || '$' || '%' || '&' || '*' || '+' || '-' || '.' ||
- '/' || ':' || '<' || '=' || '>' || '?' || '@' ||
- '^' || '|' || '~'
+ '~' || '!' || '?' || core-operator-char || '%' || '<' || ':' || '.'
+;
+core-operator-char:
+ '$' || '&' || '*' || '+' || '-' || '/' || '=' || '>' || '@' || '^' || '|'
\end{syntax}
See also the following language extensions:
-\hyperref[s:ext-ops]{extension operators} and
-\hyperref[s:index-operators]{extended indexing operators}.
+\hyperref[s:ext-ops]{extension operators},
+\hyperref[s:index-operators]{extended indexing operators},
+and \hyperref[s:binding-operators]{binding operators}.
Sequences of ``operator characters'', such as "<=>" or "!!",
are read as a single token from the @infix-symbol@ or @prefix-symbol@
%% between backquote characters @'`' lowercase-ident '`'@ are also parsed
%% as infix operators.
-\subsubsection*{Keywords}
+\subsubsection*{sss:keywords}{Keywords}
The identifiers below are reserved as keywords, and cannot be employed
otherwise:
parser value $ $$ $: <: << >> ??
\end{verbatim}
-\subsubsection*{Ambiguities}
+\subsubsection*{sss:lex-ambiguities}{Ambiguities}
Lexical ambiguities are resolved according to the ``longest match''
rule: when a character sequence can be decomposed into two tokens in
several different ways, the decomposition retained is the one with the
longest first token.
-\subsubsection*{Line number directives}
+\subsubsection*{sss:lex-linedir}{Line number directives}
\begin{syntax}
linenum-directive:
-\section{Module types (module specifications)}
+\section{s:modtypes}{Module types (module specifications)}
%HEVEA\cutname{modtypes.html}
Module types are the module-level equivalent of type expressions: they
\hyperref[s:extension-nodes]{extension nodes} and
\hyperref[s:generative-functors]{generative functors}.
-\subsection{Simple module types}
+\subsection{ss:mty-simple}{Simple module types}
The expression @modtype-path@ is equivalent to the module type bound
to the name @modtype-path@.
The expression @'(' module-type ')'@ denotes the same type as
@module-type@.
-\subsection{Signatures}
+\subsection{ss:mty-signatures}{Signatures}
\ikwd{sig\@\texttt{sig}}
\ikwd{end\@\texttt{end}}
signature. It serves as a syntactic separator with no semantic
meaning.
-\subsubsection*{Value specifications}
+\subsubsection*{sss:mty-values}{Value specifications}
\ikwd{val\@\texttt{val}}
implemented as the external function specified in @external-declaration@
(see chapter~\ref{c:intf-c}).
-\subsubsection*{Type specifications}
+\subsubsection*{sss:mty-type}{Type specifications}
\ikwd{type\@\texttt{type}}
made visible to all users, and no fresh type is generated.
\end{description}
-\subsubsection*{Exception specification}
+\subsubsection*{sss:mty-exn}{Exception specification}
\ikwd{exception\@\texttt{exception}}
specified in the definition, and makes the exception available to all
users of the structure.
-\subsubsection*{Class specifications}
+\subsubsection*{sss:mty-class}{Class specifications}
\ikwd{class\@\texttt{class}}
of mutually recursive definitions of class names.
Class specifications are described more precisely in
-section~\ref{s:class-spec}.
+section~\ref{ss:class-spec}.
-\subsubsection*{Class type specifications}
+\subsubsection*{sss:mty-classtype}{Class type specifications}
\ikwd{class\@\texttt{class}}
\ikwd{type\@\texttt{type}}
written @'class' 'type' classtype-def@ @{ 'and' classtype-def }@ and
consists of a sequence of mutually recursive definitions of class type
names. Class type specifications are described more precisely in
-section~\ref{s:classtype}.
+section~\ref{ss:classtype}.
-\subsubsection*{Module specifications}
+\subsubsection*{sss:mty-module}{Module specifications}
\ikwd{module\@\texttt{module}}
'->' module-type@
\end{center}
-\subsubsection*{Module type specifications}
+\subsubsection*{sss:mty-mty}{Module type specifications}
\ikwd{type\@\texttt{type}}
\ikwd{module\@\texttt{module}}
@module-type@ in a matching signature, but makes the equality between
@modtype-name@ and @module-type@ apparent to all users of the signature.
-\subsubsection{Opening a module path}
+\subsubsection{sss:mty-open}{Opening a module path}
\ikwd{open\@\texttt{open}}
path accesses @module-path '.' name@. The scope of the @"open"@
stops at the end of the signature expression.
-\subsubsection{Including a signature}
+\subsubsection{sss:mty-include}{Including a signature}
\ikwd{include\@\texttt{include}}
at the location of the @'include'@. The @module-type@ argument must
refer to a module type that is a signature, not a functor type.
-\subsection{Functor types}
+\subsection{ss:mty-functors}{Functor types}
\ikwd{functor\@\texttt{functor}}
particular, a functor may take another functor as argument
(``higher-order'' functor).
-\subsection{The "with" operator}
+\subsection{ss:mty-with}{The "with" operator}
\ikwd{with\@\texttt{with}}
-\section{Module\label{s:module-expr} expressions (module implementations)}
+\section{s:module-expr}{Module expressions (module implementations)}
%HEVEA\cutname{modules.html}
Module expressions are the module-level equivalent of value
| 'include' module-expr
\end{syntax}
See also the following language extensions:
-\hyperref[s-recursive-modules]{recursive modules},
-\hyperref[s-first-class-modules]{first-class modules},
+\hyperref[s:recursive-modules]{recursive modules},
+\hyperref[s:first-class-modules]{first-class modules},
\hyperref[s:explicit-overriding-open]{overriding in open statements},
\hyperref[s:attributes]{attributes},
\hyperref[s:extension-nodes]{extension nodes} and
\hyperref[s:generative-functors]{generative functors}.
-\subsection{Simple module expressions}
+\subsection{ss:mexpr-simple}{Simple module expressions}
The expression @module-path@ evaluates to the module bound to the name
@module-path@.
all components not specified in @module-type@ are hidden and can no
longer be accessed.
-\subsection{Structures}
+\subsection{ss:mexpr-structures}{Structures}
\ikwd{struct\@\texttt{struct}}
\ikwd{end\@\texttt{end}}
evaluated for its side-effects but is not bound to any identifier. If @expr@ is
the first component of a structure, the preceding ";;" can be omitted.
-\subsubsection*{Value definitions}
+\subsubsection*{sss:mexpr-value-defs}{Value definitions}
\ikwd{let\@\texttt{let}}
A value definition @'let' ['rec'] let-binding { 'and' let-binding }@
bind value names in the same way as a @'let' \ldots 'in' \ldots@ expression
-(see section~\ref{s:localdef}). The value names appearing in the
+(see section~\ref{sss:expr-localdef}). The value names appearing in the
left-hand sides of the bindings are bound to the corresponding values
in the right-hand sides.
implements @value-name@ as the external function specified in
@external-declaration@ (see chapter~\ref{c:intf-c}).
-\subsubsection*{Type definitions}
+\subsubsection*{sss:mexpr-type-defs}{Type definitions}
\ikwd{type\@\texttt{type}}
@'type' typedef { 'and' typedef }@ and consists of a sequence
of mutually recursive definitions of type names.
-\subsubsection*{Exception definitions}
+\subsubsection*{sss:mexpr-exn-defs}{Exception definitions}
\ikwd{exception\@\texttt{exception}}
Exceptions are defined with the syntax @'exception' constr-decl@
or @'exception' constr-name '=' constr@.
-\subsubsection*{Class definitions}
+\subsubsection*{sss:mexpr-class-defs}{Class definitions}
\ikwd{class\@\texttt{class}}
A definition of one or several classes is written @'class'
class-binding { 'and' class-binding }@ and consists of a sequence of
mutually recursive definitions of class names. Class definitions are
-described more precisely in section~\ref{s:classdef}.
+described more precisely in section~\ref{ss:class-def}.
-\subsubsection*{Class type definitions}
+\subsubsection*{sss:mexpr-classtype-defs}{Class type definitions}
\ikwd{class\@\texttt{class}}
\ikwd{type\@\texttt{type}}
@'class' 'type' classtype-def { 'and' classtype-def }@ and consists of
a sequence of mutually recursive definitions of class type names.
Class type definitions are described more precisely in
-section~\ref{s:classtype}.
+section~\ref{ss:classtype}.
-\subsubsection*{Module definitions}
+\subsubsection*{sss:mexpr-module-defs}{Module definitions}
\ikwd{module\@\texttt{module}}
'->' module-expr@
\end{center}
-\subsubsection*{Module type definitions}
+\subsubsection*{sss:mexpr-modtype-defs}{Module type definitions}
\ikwd{type\@\texttt{type}}
\ikwd{module\@\texttt{module}}
It binds the name @modtype-name@ to the module type denoted by the
expression @module-type@.
-\subsubsection*{Opening a module path}
+\subsubsection*{sss:mexpr-open}{Opening a module path}
\ikwd{open\@\texttt{open}}
@name@ instead of path accesses @module-path '.' name@. The scope of
the @"open"@ stops at the end of the structure expression.
-\subsubsection*{Including the components of another structure}
+\subsubsection*{sss:mexpr-include}{Including the components of another structure}
\ikwd{include\@\texttt{include}}
while @'include'@ also adds definitions for the components of the
included structure.
-\subsection{Functors}
+\subsection{ss:mexpr-functors}{Functors}
-\subsubsection*{Functor definition}
+\subsubsection*{sss:mexpr-functor-defs}{Functor definition}
\ikwd{functor\@\texttt{functor}}
functor argument; in particular, a functor may take another functor as
argument (``higher-order'' functor).
-\subsubsection*{Functor application}
+\subsubsection*{sss:mexpr-functor-app}{Functor application}
The expression @module-expr_1 '(' module-expr_2 ')'@ evaluates
@module-expr_1@ to a functor and @module-expr_2@ to a module, and
-\section{Names} \label{s:names}
+\section{s:names}{Names}
%HEVEA\cutname{names.html}
Identifiers are used to give names to several classes of language
\begin{itemize}
\item value names (syntactic class @value-name@),
\item value constructors and exception constructors (class @constr-name@),
-\item labels (@label-name@, defined in section~\ref{s:labelname}),
+\item labels (@label-name@, defined in section~\ref{sss:labelname}),
\item polymorphic variant tags (@tag-name@),
\item type constructors (@typeconstr-name@),
\item record fields (@field-name@),
uppercase (written @capitalized-ident@). Underscore is considered a
lowercase letter for this purpose.
-\subsubsection*{Naming objects}
+\subsubsection*{sss:naming-objects}{Naming objects}
\ikwd{mod\@\texttt{mod}}
\ikwd{land\@\texttt{land}}
\ikwd{lor\@\texttt{lor}}
suggest you avoid lowercase variant tags for portability and
compatibility with future OCaml versions.
-\subsubsection*{Referring to named objects}
+\subsubsection*{sss:refer-named}{Referring to named objects}
\begin{syntax}
value-path:
-\section{Patterns}
+\section{s:patterns}{Patterns}
\ikwd{as\@\texttt{as}}
%HEVEA\cutname{patterns.html}
\begin{syntax}
| char-literal '..' char-literal
| 'lazy' pattern
| 'exception' pattern
+ | module-path '.(' pattern ')'
+ | module-path '.[' pattern ']'
+ | module-path '.[|' pattern '|]'
+ | module-path '.{' pattern '}'
\end{syntax}
See also the following language extensions:
-\hyperref[s:local-opens]{local opens},
-\hyperref[s-first-class-modules]{first-class modules},
+\hyperref[s:first-class-modules]{first-class modules},
\hyperref[s:attributes]{attributes} and
\hyperref[s:extension-nodes]{extension nodes}.
\ikwd{as\@\texttt{as}}
\begin{tableau}{|l|l|}{Operator}{Associativity}
\entree{".."}{--}
-\entree{"lazy" (see section~\ref{s:lazypat})}{--}
+\entree{"lazy" (see section~\ref{sss:pat-lazy})}{--}
\entree{Constructor application, Tag application}{right}
\entree{"::"}{right}
\entree{","}{--}
``this value matches this pattern, resulting in the following bindings
of names to values''.
-\subsubsection*{Variable patterns}
+\subsubsection*{sss:pat-variable}{Variable patterns}
A pattern that consists in a value name matches any value,
binding the name to the value. The pattern @"_"@ also matches
between two parts of a data structure using only a pattern (but
@"when"@ guards can be used for this purpose).
-\subsubsection*{Constant patterns}
+\subsubsection*{sss:pat-const}{Constant patterns}
A pattern consisting in a constant matches the values that
are equal to this constant.
%% FIXME for negative numbers, blanks are allowed between the minus
%% sign and the first digit.
-\subsubsection*{Alias patterns}
+\subsubsection*{sss:pat-alias}{Alias patterns}
\ikwd{as\@\texttt{as}}
The pattern @pattern_1 "as" value-name@ matches the same values as
the name @value-name@ is bound to the matched value, in addition to the
bindings performed by the matching against @pattern_1@.
-\subsubsection*{Parenthesized patterns}
+\subsubsection*{sss:pat-parenthesized}{Parenthesized patterns}
The pattern @"(" pattern_1 ")"@ matches the same values as
@pattern_1@. A type constraint can appear in a
constraint forces the type of @pattern_1@ to be compatible with
@typexpr@.
-\subsubsection*{``Or'' patterns}
+\subsubsection*{sss:pat-or}{``Or'' patterns}
The pattern @pattern_1 "|" pattern_2@ represents the logical ``or'' of
the two patterns @pattern_1@ and @pattern_2@. A value matches
Otherwise, value~$v$ matches @pattern_2@ whose bindings are performed.
-\subsubsection*{Variant patterns}
+\subsubsection*{sss:pat-variant}{Variant patterns}
The pattern @constr '(' pattern_1 ',' \ldots ',' pattern_n ')'@ matches
all variants whose
respectively. This pattern behaves like
@pattern_1 "::" \ldots "::" pattern_n "::" "[]"@.
-\subsubsection*{Polymorphic variant patterns}
+\subsubsection*{sss:pat-polyvar}{Polymorphic variant patterns}
The pattern @"`"tag-name pattern_1@ matches all polymorphic variants
whose tag is equal to @tag-name@, and whose argument matches
@pattern_1@.
-\subsubsection*{Polymorphic variant abbreviation patterns}
+\subsubsection*{sss:pat-polyvar-abbrev}{Polymorphic variant abbreviation patterns}
If the type @["('a,'b,"\ldots")"] typeconstr = "[" "`"tag-name_1 typexpr_1 "|"
\ldots "|" "`"tag-name_n typexpr_n"]"@ is defined, then the pattern @"#"typeconstr@
@"(" "`"tag-name_1"(_" ":" typexpr_1")" "|" \ldots "|" "`"tag-name_n"(_"
":" typexpr_n"))"@. It matches all values of type @"[<" typeconstr "]"@.
-\subsubsection*{Tuple patterns}
+\subsubsection*{sss:pat-tuple}{Tuple patterns}
The pattern @pattern_1 "," \ldots "," pattern_n@ matches $n$-tuples
whose components match the patterns @pattern_1@ through @pattern_n@. That
is, the pattern matches the tuple values $(v_1, \ldots, v_n)$ such that
@pattern_i@ matches $v_i$ for \fromoneto{i}{n}.
-\subsubsection*{Record patterns}
+\subsubsection*{sss:pat-record}{Record patterns}
The pattern @"{" field_1 ["=" pattern_1] ";" \ldots ";" field_n ["="
pattern_n] "}"@ matches records that define at least the fields
of @field_k@ to be compatible with @typexpr_k@.
-\subsubsection*{Array patterns}
+\subsubsection*{sss:pat-array}{Array patterns}
The pattern @"[|" pattern_1 ";" \ldots ";" pattern_n "|]"@
matches arrays of length $n$ such that the $i$-th array element
matches the pattern @pattern_i@, for \fromoneto{i}{n}.
-\subsubsection*{Range patterns}
+\subsubsection*{sss:pat-range}{Range patterns}
The pattern
@"'" @c@ "'" ".." "'" @d@ "'"@ is a shorthand for the pattern
that occur between \var{c} and \var{d} in the ASCII character set. For
instance, the pattern "'0'"@'..'@"'9'" matches all characters that are digits.
-\subsubsection{Lazy patterns} \label{s:lazypat}
+\subsubsection{sss:pat-lazy}{Lazy patterns}
\ikwd{lazy\@\texttt{lazy}}
\index{Lazy (module)\@\verb`Lazy` (module)}%
\index{force\@\verb`force`}%
-\subsubsection*{Exception patterns} \label{s:exception-match}
+\subsubsection*{sss:exception-match}{Exception patterns}
(Introduced in OCaml 4.02)
A new form of exception pattern, @ 'exception' pattern @, is allowed
A pattern match must contain at least one value case. It is an error if
all cases are exceptions, because there would be no code to handle
the return of a value.
+
+\subsubsection*{sss:pat-open}{Local opens for patterns}
+\ikwd{open\@\texttt{open}}
+(Introduced in OCaml 4.04)
+
+For patterns, local opens are limited to the
+@module-path'.('pattern')'@ construction. This
+construction locally opens the module referred to by the module path
+@module-path@ in the scope of the pattern @pattern@.
+
+When the body of a local open pattern is delimited by
+@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted.
+For example, @module-path'.['pattern']'@ is equivalent to
+@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is
+equivalent to @module-path'.([|' pattern '|])'@.
%HEVEA\cutname{language.html}
%better html output that way, sniff.
-%HEVEA\subsection*{Foreword}
+%HEVEA\subsection*{ss:foreword}{Foreword}
%BEGIN LATEX
-\section*{Foreword}
+\section*{s:foreword}{Foreword}
%END LATEX
This document is intended as a reference manual for the OCaml
definitely part of a full formal definition of the language.
-\subsection*{Notations}
+\subsection*{ss:notations}{Notations}
The syntax of the language is given in BNF-like notation. Terminal
symbols are set in typewriter font (@'like' 'this'@).
-\section{Type and exception definitions}
+\section{s:tydef}{Type and exception definitions}
%HEVEA\cutname{typedecl.html}%
-\subsection{Type definitions}
-\label{s:type-defs}
+\subsection{ss:typedefs}{Type definitions}
Type definitions bind type constructors to data types: either
variant types, record types, type abbreviations, or abstract data
prefixed by "+" or "-" to indicate that the type constructor is
covariant or contravariant with respect to this parameter. This
variance information is used to decide subtyping relations when
-checking the validity of @":>"@ coercions (see section \ref{s:coercions}).
+checking the validity of @":>"@ coercions
+(see section \ref{ss:expr-coercions}).
For instance, "type +'a t" declares "t" as an abstract type that is
covariant in its parameter; this means that if the type $\tau$ is a
@ident@ and @typexpr@ are unified). Type variables of @typexpr@ can
appear in the type equation and the type declaration.
-\subsection{Exception definitions} \label{s:excdef}
+\subsection{ss:exndef}{Exception definitions}
\ikwd{exception\@\texttt{exception}}
\begin{syntax}
-\section{Type expressions}
+\section{s:typexpr}{Type expressions}
%HEVEA\cutname{types.html}
\ikwd{as\@\texttt{as}}
method-name ':' poly-typexpr
\end{syntax}
See also the following language extensions:
-\hyperref[s-first-class-modules]{first-class modules},
+\hyperref[s:first-class-modules]{first-class modules},
\hyperref[s:attributes]{attributes} and
\hyperref[s:extension-nodes]{extension nodes}.
Type expressions denote types in definitions of data types as well as
in type constraints over patterns and expressions.
-\subsubsection*{Type variables}
+\subsubsection*{sss:typexpr-variables}{Type variables}
The type expression @"'" ident@ stands for the type variable named
@ident@. The type expression @"_"@ stands for either an anonymous type
1) for universal (explicitly polymorphic) type variables;
2) for type variables that only appear in public method specifications
(as those variables will be made universal, as described in
-section~\ref{sec-methspec});
+section~\ref{sss:clty-meth});
3) for variables used as aliases, when the type they are aliased to
would be invalid in the scope of the enclosing definition ({\it i.e.}
when it contains free universal type variables, or locally
defined types.)
-\subsubsection*{Parenthesized types}
+\subsubsection*{sss:typexr:parenthesized}{Parenthesized types}
The type expression @"(" typexpr ")"@ denotes the same type as
@typexpr@.
-\subsubsection*{Function types}
+\subsubsection*{sss:typexr-fun}{Function types}
The type expression @typexpr_1 '->' typexpr_2@ denotes the type of
functions mapping arguments of type @typexpr_1@ to results of type
type @typexpr_2@. That is, the physical type of the function will be
@typexpr_1 "option" '->' typexpr_2@.
-\subsubsection*{Tuple types}
+\subsubsection*{sss:typexpr-tuple}{Tuple types}
The type expression @typexpr_1 '*' \ldots '*' typexpr_n@
denotes the type of tuples whose elements belong to types @typexpr_1,
\ldots typexpr_n@ respectively.
-\subsubsection*{Constructed types}
+\subsubsection*{sss:typexpr-constructed}{Constructed types}
Type constructors with no parameter, as in @typeconstr@, are type
expressions.
@ ("_", \ldots,"_") @ with as many repetitions of "_" as the arity of
@typeconstr@.
-\subsubsection*{Aliased and recursive types}
+\subsubsection*{sss:typexpr-aliased-recursive}{Aliased and recursive types}
\ikwd{as\@\texttt{as}}
denotes either an object or polymorphic variant type, the row variable
of @typexpr@ is captured by @"'" ident@, and quantified upon.
-\subsubsection*{Polymorphic variant types}
+\subsubsection*{sss:typexpr-polyvar}{Polymorphic variant types}
\ikwd{of\@\texttt{of}}
\begin{syntax}
checker. When they are used in source programs, unsolvable constraints
may cause early failures.
-\subsubsection*{Object types}
+\subsubsection*{sss:typexpr-obj}{Object types}
An object type
@'<' [method-type { ';' method-type }] '>'@
a special kind of type variable (called {\em row variable} in the
literature) that stands for any number of extra method types.
-\subsubsection*{\#-types}
-\label{s:sharp-types}
+\subsubsection*{sss:typexpr-sharp-types}{\#-types}
The type @'#' class-path@ is a special kind of abbreviation. This
abbreviation unifies with the type of any object belonging to a subclass
and @"#"@t@"[>" "`"tag_1 \dots"`"tag_k"]"@ translates to
@"[<" @t@ ">" "`"tag_1 \dots"`"tag_k"]"@
-\subsubsection*{Variant and record types}
+\subsubsection*{sss:typexpr-variant-record}{Variant and record types}
There are no type expressions describing (defined) variant types nor
record types, since those are always named, i.e. defined before use
and referred to by name. Type definitions are described in
-section~\ref{s:type-defs}.
+section~\ref{ss:typedefs}.
-\section{Values}
+\section{s:values}{Values}
%HEVEA\cutname{values.html}
This section describes the kinds of values that are manipulated by
OCaml programs.
-\subsection{Base values}
+\subsection{ss:values:base}{Base values}
-\subsubsection*{Integer numbers}
+\subsubsection*{sss:values:integer}{Integer numbers}
Integer values are integer numbers from $-2^{30}$ to $2^{30}-1$, that
is $-1073741824$ to $1073741823$. The implementation may support a
wider range of integer values: on 64-bit platforms, the current
implementation supports integers ranging from $-2^{62}$ to $2^{62}-1$.
-\subsubsection*{Floating-point numbers}
+\subsubsection*{sss:values:float}{Floating-point numbers}
Floating-point values are numbers in floating-point representation.
The current implementation uses double-precision floating-point
numbers conforming to the IEEE 754 standard, with 53 bits of mantissa
and an exponent ranging from $-1022$ to $1023$.
-\subsubsection*{Characters}
+\subsubsection*{sss:values:char}{Characters}
Character values are represented as 8-bit integers between 0 and 255.
Character codes between 0 and 127 are interpreted following the ASCII
standard. The current implementation interprets character codes
between 128 and 255 following the ISO 8859-1 standard.
-\subsubsection*{Character strings} \label{s:string-val}
+\subsubsection*{sss:values:string}{Character strings}
String values are finite sequences of characters. The current
implementation supports strings containing up to $2^{24} - 5$
characters (16777211 characters); on 64-bit platforms, the limit is
$2^{57} - 9$.
-\subsection{Tuples}
+\subsection{ss:values:tuple}{Tuples}
Tuples of values are written @'('@v@_1',' \ldots',' @v@_n')'@, standing for the
$n$-tuple of values @@v@_1@ to @@v@_n@. The current implementation
supports tuple of up to $2^{22} - 1$ elements (4194303 elements).
-\subsection{Records}
+\subsection{ss:values:records}{Records}
Record values are labeled tuples of values. The record value written
@'{' field_1 '=' @v@_1';' \ldots';' field_n '=' @v@_n '}'@ associates the value
implementation supports records with up to $2^{22} - 1$ fields
(4194303 fields).
-\subsection{Arrays}
+\subsection{ss:values:array}{Arrays}
Arrays are finite, variable-sized sequences of values of the same
type. The current implementation supports arrays containing up to
floating-point numbers (2097151 elements in this case); on 64-bit
platforms, the limit is $2^{54} - 1$ for all arrays.
-\subsection{Variant values}
+\subsection{ss:values:variant}{Variant values}
Variant values are either a constant constructor, or a non-constant
constructor applied to a number of values. The former case is written
The current implementation limits each variant type to have at most
246 non-constant constructors and $2^{30}-1$ constant constructors.
-\subsection{Polymorphic variants}
+\subsection{ss:values:polyvars}{Polymorphic variants}
Polymorphic variants are an alternate form of variant values, not
belonging explicitly to a predefined variant type, and following
specific typing rules. They can be either constant, written
@"`"tag-name@, or non-constant, written @"`"tag-name'('@v@')'@.
-\subsection{Functions}
+\subsection{ss:values:fun}{Functions}
Functional values are mappings from values to values.
-\subsection{Objects}
+\subsection{ss:values:obj}{Objects}
Objects are composed of a hidden internal state which is a
record of instance variables, and a set of methods for accessing and
programming pattern known as {\em virtual types} through the example
of window managers.
-\section{Extended example: bank accounts}
-\label{ss:bank-accounts}
+\section{s:extended-bank-accounts}{Extended example: bank accounts}
In this section, we illustrate most aspects of Object and inheritance
by refining, debugging, and specializing the following
\end{caml_eval}
-\section{Simple modules as classes}
-\label{ss:modules-as-classes}
+\section{s:modules-as-classes}{Simple modules as classes}
One may wonder whether it is possible to treat primitive types such as
integers and strings as objects. Although this is usually uninteresting
this is desirable. The class "money" above is such an example.
We show here how to do it for strings.
-\subsection{Strings}
-\label{module:string}
+\subsection{ss:string-as-class}{Strings}
A naive definition of strings as objects could be:
\begin{caml_example}{toplevel}
method sub start len = new sub_string (String.sub s start len)
end;;
\end{caml_example}
-As seen in section \ref{ss:binary-methods}, the solution is to use
+As seen in section~\ref{s:binary-methods}, the solution is to use
functional update instead. We need to create an instance variable
containing the representation "s" of the string.
\begin{caml_example}{toplevel}
\end{caml_example}
Here, exposing the representation of strings is probably harmless. We do
could also hide the representation of strings as we hid the currency in the
-class "money" of section~\ref{ss:friends}.
+class "money" of section~\ref{s:friends}.
-\subsubsection{Stacks}
-\label{module:stack}
+\subsubsection{sss:stack-as-class}{Stacks}
There is sometimes an alternative between using modules or classes for
parametric data types.
% XXX Maps
-\subsection{Hashtbl}
-\label{module:hashtbl}
+\subsection{ss:hashtbl-as-class}{Hashtbl}
A simplified version of object-oriented hash tables should have the
following class type.
% solution
-\subsection{Sets}
-\label{module:set}
+\subsection{ss:set-as-class}{Sets}
Implementing sets leads to another difficulty. Indeed, the method
"union" needs to be able to access the internal representation of
another object of the same class.
-This is another instance of friend functions as seen in section
-\ref{ss:friends}. Indeed, this is the same mechanism used in the module
+This is another instance of friend functions as seen in
+section~\ref{s:friends}. Indeed, this is the same mechanism used in the module
"Set" in the absence of objects.
In the object-oriented version of sets, we only need to add an additional
end;;
\end{caml_example*}
-\section{The subject/observer pattern}
-\label{ss:subject-observer}
+\section{s:subject-observer}{The subject/observer pattern}
The following example, known as the subject/observer pattern, is often
presented in the literature as a difficult inheritance problem with
window#move 1; window#resize 2;;
\end{caml_example}
-%\subsection{Classes used as modules with inheritance}
+%\subsection{ss:Classes used as modules with inheritance}
%
% to be filled for next release...
%
extensions to the core language (labeled arguments and polymorphic
variants), and chapter~\ref{c:advexamples} gives some advanced examples.
-\section{Basics}
+\section{s:basics}{Basics}
For this overview of OCaml, we use the interactive system, which
is started by running "ocaml" from the Unix shell, or by launching the
fib 10;;
\end{caml_example}
-\section{Data types}
+\section{s:datatypes}{Data types}
In addition to integers and floating-point numbers, OCaml offers the
usual basic data types:
the type inferred for "insert", "'a -> 'a list -> 'a list", means that "insert"
takes two arguments, an element of any type "'a" and a list with elements of
the same type "'a" and returns a list of the same type.
-\section{Functions as values}
+\section{s:functions-as-values}{Functions as values}
OCaml is a functional language: functions in the full mathematical
sense are supported and can be passed around freely just as any other
| hd :: tl -> f hd :: map f tl;;
\end{caml_example}
-\section{Records and variants}
-\label{s:tut-recvariants}
+\section{s:tut-recvariants}{Records and variants}
User-defined data structures include records and variants. Both are
defined with the "type" declaration. Here, we declare a record type to
\end{caml_example}
-\subsection{Record and variant disambiguation}
+\subsection{ss:record-and-variant-disambiguation}{Record and variant disambiguation}
( This subsection can be skipped on the first reading )
Astute readers may have wondered what happens when two or more record
Consequently, adding explicit type annotations to guide disambiguation is
more robust than relying on the last defined type disambiguation.
-\section{Imperative features}
+\section{s:imperative-features}{Imperative features}
Though all examples so far were written in purely applicative style,
OCaml is also equipped with full imperative features. This includes the
g r;;
\end{caml_example}
-\section{Exceptions}
+\section{s:exceptions}{Exceptions}
OCaml provides exceptions for signalling and handling exceptional
conditions. Exceptions can also be used as a general-purpose non-local
the function "f" cannot raise a "Done" exception, which removes an
entire class of misbehaving functions.
-\section{Lazy expressions}
+\section{s:lazy-expr}{Lazy expressions}
OCaml allows us to defer some computation until later when we need the result of
that computation.
the lazy expression's evaluation. However, a pattern with keyword "lazy", even
if it is wildcard, always forces the evaluation of the deferred computation.
-\section{Symbolic processing of expressions}
+\section{s:symb-expr}{Symbolic processing of expressions}
We finish this introduction with a more complete example
representative of the use of OCaml for symbolic processing: formal
deriv (Quot(Const 1.0, Var "x")) "x";;
\end{caml_example}
-\section{Pretty-printing}
+\section{s:pretty-printing}{Pretty-printing}
As shown in the examples above, the internal representation (also
called {\em abstract syntax\/}) of expressions quickly becomes hard to
print_expr (deriv e "x"); print_newline ();;
\end{caml_example}
-\section{Printf formats}
+\section{s:printf}{Printf formats}
There is a "printf" function in the \stdmoduleref{Printf} module
(see chapter~\ref{c:moduleexamples}) that allows you to make formatted
%% the second space in "x - 1" causes the lexer to return the three
%% expected tokens: "Ident \"x\"", then "Kwd \"-\"", then "Int(1)".
-\section{Standalone OCaml programs}
+\section{s:standalone-programs}{Standalone OCaml programs}
All examples given so far were executed under the interactive system.
OCaml code can also be compiled separately and executed
\noindent This chapter gives an overview of the new features in
OCaml 3: labels, and polymorphic variants.
-\section{Labels}
+\section{s:labels}{Labels}
If you have a look at modules ending in "Labels" in the standard
library, you will see that function types have annotations you did not
h (fun ~x:_ ~y -> y+1);;
\end{caml_example}
-\subsection{Optional arguments}
+\subsection{ss:optional-arguments}{Optional arguments}
An interesting feature of labeled arguments is that they can be made
optional. For optional parameters, the question mark "?" replaces the
test2 ?x:None;;
\end{caml_example}
-\subsection{Labels and type inference}
-\label{ss:label-inference}
+\subsection{ss:label-inference}{Labels and type inference}
While they provide an increased comfort for writing function
applications, labels and optional arguments have the pitfall that they
parameters shall produce side-effects, these are delayed until the
received function is really applied to an argument.
-\subsection{Suggestions for labeling}
+\subsection{ss:label-suggestions}{Suggestions for labeling}
Like for names, choosing labels for functions is not an easy task. A
good labeling is a labeling which
\end{caml_eval}
-\section{Polymorphic variants}
+\section{s:polymorphic-variants}{Polymorphic variants}
Variants as presented in section~\ref{s:tut-recvariants} are a
powerful tool to build data structures and algorithms. However they
use. You need not define a type before using a variant tag. A variant
type will be inferred independently for each of its uses.
-\subsection*{Basic use}
+\subsection*{ss:polyvariant:basic-use}{Basic use}
In programs, polymorphic variants work like usual ones. You just have
to prefix their names with a backquote character "`".
;;
\end{caml_example}
-\subsection*{Advanced use}
+\subsection*{ss:polyvariant-advanced}{Advanced use}
Type-checking polymorphic variants is a subtle thing, and some
expressions may result in more complex type information.
| `Tag3 -> "Tag3";;
\end{caml_example}
-\subsection{Weaknesses of polymorphic variants}
+\subsection{ss:polyvariant-weaknesses}{Weaknesses of polymorphic variants}
After seeing the power of polymorphic variants, one may wonder why
they were added to core language variants, rather than replacing them.
This chapter introduces the module system of OCaml.
-\section{Structures}
+\section{s:module:structures}{Structures}
A primary motivation for modules is to package together related
definitions (such as the definitions of a data type and associated
\begin{caml_example}{toplevel}
PrioQueue.[insert empty 1 "hello"];;
\end{caml_example}
+This second form also works for patterns:
+\begin{caml_example}{toplevel}
+ let at_most_one_element x = match x with
+ | PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true
+ | _ -> false ;;
+\end{caml_example}
It is also possible to copy the components of a module inside
another module by using an "include" statement. This can be
end;;
\end{caml_example}
-\section{Signatures}
+\section{s:signature}{Signatures}
Signatures are interfaces for structures. A signature specifies
which components of a structure are accessible from the outside, and
\end{caml_example}
-\section{Functors}
+\section{s:functors}{Functors}
Functors are ``functions'' from modules to modules. Functors let you create
parameterized modules and then provide other modules as parameter(s) to get
StringSet.member "bar" (StringSet.add "foo" StringSet.empty);;
\end{caml_example}
-\section{Functors and type abstraction}
+\section{s:functors-and-abstraction}{Functors and type abstraction}
As in the "PrioQueue" example, it would be good style to hide the
actual implementation of the type "set", so that users of the
"NoCaseStringSet.set" could give incorrect results, or build
lists that violate the invariants of "NoCaseStringSet".
-\section{Modules and separate compilation}
+\section{s:separate-compilation}{Modules and separate compilation}
All examples of modules so far have been given in the context of the
interactive system. However, modules are most useful for large,
such as modules and functors. Indeed, many OCaml programs do not use objects
at all.
-\section{Classes and objects}
-\label{ss:classes-and-objects}
+\section{s:classes-and-objects}{Classes and objects}
The class "point" below defines one instance variable "x" and two methods
"get_x" and "move". The initial value of the instance variable is "0".
This ability provides class constructors as can be found in other
languages. Several constructors can be defined this way to build objects of
the same class but with different initialization patterns; an
-alternative is to use initializers, as described below in section
-\ref{ss:initializers}.
+alternative is to use initializers, as described below in
+section~\ref{s:initializers}.
-\section{Immediate objects}
-\label{ss:immediate-objects}
+\section{s:immediate-objects}{Immediate objects}
There is another, more direct way to create an object: create it
without going through a class.
Immediate objects have two weaknesses compared to classes: their types
are not abbreviated, and you cannot inherit from them. But these two
weaknesses can be advantages in some situations, as we will see
-in sections \ref{ss:reference-to-self} and \ref{ss:parameterized-classes}.
+in sections~\ref{s:reference-to-self} and~\ref{s:parameterized-classes}.
-\section{Reference to self}
-\label{ss:reference-to-self}
+\section{s:reference-to-self}{Reference to self}
A method or an initializer can invoke methods on self (that is,
the current object). For that, self must be explicitly bound, here to
You can ignore the first two lines of the error message. What matters
is the last one: putting self into an external reference would make it
impossible to extend it through inheritance.
-We will see in section \ref{ss:using-coercions} a workaround to this
+We will see in section~\ref{s:using-coercions} a workaround to this
problem.
Note however that, since immediate objects are not extensible, the
problem does not occur with them.
end;;
\end{caml_example}
-\section{Initializers}
-\label{ss:initializers}
+\section{s:initializers}{Initializers}
Let-bindings within class definitions are evaluated before the object
is constructed. It is also possible to evaluate an expression
Initializers cannot be overridden. On the contrary, all initializers are
evaluated sequentially.
Initializers are particularly useful to enforce invariants.
-Another example can be seen in section \ref{ss:bank-accounts}.
+Another example can be seen in section~\ref{s:extended-bank-accounts}.
-\section{Virtual methods}
-\label{ss:virtual-methods}
+\section{s:virtual-methods}{Virtual methods}
It is possible to declare a method without actually defining it, using
the keyword "virtual". This method will be provided later in
end;;
\end{caml_example}
-\section{Private methods}
-\label{ss:private-methods}
+\section{s:private-methods}{Private methods}
Private methods are methods that do not appear in object interfaces.
They can only be invoked from other methods of the same object.
and classes in OCaml: two unrelated classes may produce
objects of the same type, and there is no way at the type level to
ensure that an object comes from a specific class. However a possible
-encoding of friend methods is given in section \ref{ss:friends}.
+encoding of friend methods is given in section~\ref{s:friends}.
Private methods are inherited (they are by default visible in subclasses),
unless they are hidden by signature matching, as described below.
Of course, private methods can also be virtual. Then, the keywords must
appear in this order "method private virtual".
-\section{Class interfaces}
-\label{ss:class-interfaces}
+\section{s:class-interfaces}{Class interfaces}
%XXX Differentiate class type and class interface ?
end;;
\end{caml_example}
-\section{Inheritance}
-\label{ss:inheritance}
+\section{s:inheritance}{Inheritance}
We illustrate inheritance by defining a class of colored points that
inherits from the class of points. This class has all instance
let incr p = set_x p (get_succ_x p);;
\end{caml_example}
-\section{Multiple inheritance}
-\label{ss:multiple-inheritance}
+\section{s:multiple-inheritance}{Multiple inheritance}
Multiple inheritance is allowed. Only the last definition of a method
is kept: the redefinition in a subclass of a method that was visible in
end;;
\end{caml_example}
-\section{Parameterized classes}
-\label{ss:parameterized-classes}
+\section{s:parameterized-classes}{Parameterized classes}
Reference cells can be implemented as objects.
The naive definition fails to typecheck:
end;;
\end{caml_example}
-\section{Polymorphic methods}
-\label{ss:polymorphic-methods}
+\section{s:polymorphic-methods}{Polymorphic methods}
While parameterized classes may be polymorphic in their contents, they
are not enough to allow polymorphism of method use.
\end{caml_example}
Another use of polymorphic methods is to allow some form of implicit
-subtyping in method arguments. We have already seen in section
-\ref{ss:inheritance} how some functions may be polymorphic in the
+subtyping in method arguments. We have already seen in
+section~\ref{s:inheritance} how some functions may be polymorphic in the
class of their argument. This can be extended to methods.
\begin{caml_example}{toplevel}
class type point0 = object method get_x : int end;;
itself polymorphic. In method "m2", the argument of "n2" and "x" must
have the same type, which is quantified at the same level as "'a".
-\section{Using coercions}
-\label{ss:using-coercions}
+\section{s:using-coercions}{Using coercions}
Subtyping is never implicit. There are, however, two ways to perform
subtyping. The most general construction is fully explicit: both the
You may also note that the type of "to_c2" is "#c2 -> c2" while
the type of "to_c1" is more general than "#c1 -> c1". This is not always true,
since there are class types for which some instances of "#c" are not subtypes
-of "c", as explained in section~\ref{ss:binary-methods}. Yet, for
+of "c", as explained in section~\ref{s:binary-methods}. Yet, for
parameterless classes the coercion "(_ :> c)" is always more general than
"(_ : #c :> c)".
%If a class type exposes the type of self through one of its parameters, this
\end{caml_example*}
with an extra type variable capturing the open object type.
-\section{Functional objects}
-\label{ss:functional-objects}
+\section{s:functional-objects}{Functional objects}
It is possible to write a version of class "point" without assignments
on the instance variables. The override construct "{< ... >}" returns a copy of
object of the subclass.
Functional update is often used in conjunction with binary methods
-as illustrated in section \ref{module:string}.
+as illustrated in section~\ref{ss:string-as-class}.
-\section{Cloning objects}
-\label{ss:cloning-objects}
+\section{s:cloning-objects}{Cloning objects}
Objects can also be cloned, whether they are functional or imperative.
The library function "Oo.copy" makes a shallow copy of an object. That is,
-\section{Recursive classes}
-\label{ss:recursive-classes}
+\section{s:recursive-classes}{Recursive classes}
Recursive classes can be used to define objects whose types are
mutually recursive.
"window" are themselves independent.
-\section{Binary methods}
-\label{ss:binary-methods}
+\section{s:binary-methods}{Binary methods}
A binary method is a method which takes an argument of the same type
as self. The class "comparable" below is a template for classes with a
(min (new money2 5.0) (new money2 3.14))#value;;
\end{caml_example}
-More examples of binary methods can be found in sections
-\ref{module:string} and \ref{module:set}.
+More examples of binary methods can be found in
+sections~\ref{ss:string-as-class} and~\ref{ss:set-as-class}.
Note the use of override for method "times".
Writing "new money2 (k *. repr)" instead of "{< repr = k *. repr >}"
end;;
\end{caml_example}
-\section{Friends}
-\label{ss:friends}
+\section{s:friends}{Friends}
The above class "money" reveals a problem that often occurs with binary
methods. In order to interact with other objects of the same class, the
end
end;;
\end{caml_example*}
-Another example of friend functions may be found in section
-\ref{module:set}. These examples occur when a group of objects (here
+Another example of friend functions may be found in section~\ref{ss:set-as-class}.
+These examples occur when a group of objects (here
objects of the same class) and functions should see each others internal
representation, while their representation should be hidden from the
outside. The solution is always to define all friends in the same module,
This chapter details each of these situations and, if it is possible,
how to recover genericity.
-\section{Weak polymorphism and mutation}
-\subsection{Weakly polymorphic types}
-\label{ss:weaktypes}
+\section{s:weak-polymorphism}{Weak polymorphism and mutation}
+\subsection{ss:weak-types}{Weakly polymorphic types}
Maybe the most frequent examples of non-genericity derive from the
interactions between polymorphic types and mutation. A simple example
appears when typing the following expression
at this point, this can result in confusing type errors when later, correct
uses are flagged as errors.
-\subsection{The value restriction}\label{ss:valuerestriction}
+\subsection{ss:valuerestriction}{The value restriction}
Identifying the exact context in which polymorphic types should be
replaced by weak types in a modular way is a difficult question. Indeed
checker and can therefore be generalized. This kind of manipulation is called
eta-expansion in lambda calculus and is sometimes referred under this name.
-\subsection{The relaxed value restriction}
+\subsection{ss:relaxed-value-restriction}{The relaxed value restriction}
There is another partial solution to the problem of unnecessary weak type,
which is implemented directly within the type checker. Briefly, it is possible
parameters is called the relaxed value restriction.
%question: is here the best place for describing variance?
-\subsection{Variance and value restriction}
+\subsection{ss:variance-and-value-restriction}{Variance and value restriction}
Variance describes how type constructors behave with respect to subtyping.
Consider for instance a pair of type "x" and "xy" with "x" a subtype of "xy",
denoted "x :> xy":
Together, the relaxed value restriction and type parameter covariance
help to avoid eta-expansion in many situations.
-\subsection{Abstract data types}
+\subsection{ss:variance:abstract-data-types}{Abstract data types}
Moreover, when the type definitions are exposed, the type checker
is able to infer variance information on its own and one can benefit from
the relaxed value restriction even unknowingly. However, this is not the case
List2.empty ();;
\end{caml_example}
-\section{Polymorphic recursion}\label{s:polymorphic-recursion}
+\section{s:polymorphic-recursion}{Polymorphic recursion}
The second major class of non-genericity is directly related to the problem
of type inference for polymorphic functions. In some circumstances, the type
\emph{definition} of the function "depth" whereas, here, we need a
different type variable for every \emph{application} of the function "depth".
-\subsection{Explicitly polymorphic annotations}
+\subsection{ss:explicit-polymorphism}{Explicitly polymorphic annotations}
The solution of this conundrum is to use an explicitly polymorphic type
annotation for the type "'a":
\begin{caml_example}{toplevel}
%todo: add a paragraph on the interaction with locally abstract type
-\subsection{More examples}
+\subsection{ss:recursive-poly-examples}{More examples}
With explicit polymorphic annotations, it becomes possible to implement
any recursive function that depends only on the structure of the nested
lists and not on the type of the elements. For instance, a more complex
shape (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
\end{caml_example}
-\section{Higher-rank polymorphic functions}
+\section{s:higher-rank-poly}{Higher-rank polymorphic functions}
Explicit polymorphic annotations are however not sufficient to cover all
the cases where the inferred type of a function is less general than
+++ /dev/null
-% CAML style option, for use with the caml-latex filter.
-
-\typeout{Document Style option `caml-sl' <7 Apr 92>.}
-\newcommand{\hash}{\#}
-{\catcode`\^^M=\active %
- \gdef\@camlinputline#1^^M{\normalsize\tt\hash{} #1\par} %
- \gdef\@camloutputline#1^^M{\small\ttfamily\slshape#1\par} } %
-\def\@camlblankline{\medskip}
-\chardef\@camlbackslash="5C
-\def\@bunderline{\setbox0\hbox\bgroup\let\par\@parinunderline}
-
-\def \@parinunderline {\futurelet \@next \@@parinunderline}
-\def \@@parinunderline {\ifx \@next \? \let \@do \@@par@inunderline \else \let \@do \@@@parinunderline \fi \@do}
-\def \@@par@inunderline #1{\@eunderline\@oldpar\?\@bunderline}
-\def \@@@parinunderline {\@eunderline\@oldpar\@bunderline}
-\def\@eunderline{\egroup\underline{\box0}}
-\def\@camlnoop{}
-
-\def\caml{
- \bgroup
- \parindent 0pt
- \parskip 0pt
- \let\do\@makeother\dospecials
- \catcode13=\active % 13 = ^M = CR
- \catcode92=0 % 92 = \
- \catcode32=\active % 32 = SPC
- \frenchspacing
- \@vobeyspaces
- \let\@oldpar\par
- \let\?\@camlinputline
- \let\:\@camloutputline
- \let\;\@camlblankline
- \let\<\@bunderline
- \let\>\@eunderline
- \let\\\@camlbackslash
- \let\-\@camlnoop
-}
-
-\def\endcaml{
- \egroup
- \addvspace{\medskipamount}
-}
-
-% Caml-example related command
-\def\camlexample#1{
- \ifnum\pdfstrcmp{#1}{toplevel}=0
- \renewcommand{\hash}{\#}
- \else
- \renewcommand{\hash}{}
- \fi
- \begin{flushleft}
-}
-\def\endcamlexample{\end{flushleft}\renewcommand{\hash}{\#}}
-\def\camlinput{}
-\def\endcamlinput{}
-\def\camloutput{}
-\def\endcamloutput{}
-\def\camlerror{}
-\def\endcamlerror{}
-\def\camlwarn{}
-\def\endcamlwarn{}
+++ /dev/null
-% CAML style option, for use with the caml-latex filter.
-
-\typeout{Document Style option `caml' <7 Apr 92>.}
-
-{\catcode`\^^M=\active %
- \gdef\@camlinputline#1^^M{\tt\##1\par} %
- \gdef\@camloutputline#1^^M{\tt#1\par} } %
-\def\@camlblankline{\medskip}
-\chardef\@camlbackslash="5C
-
-\def\caml{
- \bgroup
- \flushleft
- \parindent 0pt
- \parskip 0pt
- \let\do\@makeother\dospecials
- \catcode`\^^M=\active
- \catcode`\\=0
- \catcode`\ \active
- \frenchspacing
- \@vobeyspaces
- \let\?\@camlinputline
- \let\:\@camloutputline
- \let\;\@camlblankline
- \let\\\@camlbackslash
-}
-
-\def\endcaml{
- \endflushleft
- \egroup\noindent
-}
% Changed \next to \html@next to prevent clashes with other sty files
% (mike@emn.fr)
% Changed \html@next to \htmlnext so the \makeatletter and
-% \makeatother commands could be removed (they were cuasing other
+% \makeatother commands could be removed (they were causing other
% style files - changebar.sty - to crash) (nikos@cbl.leeds.ac.uk)
TOPDIR=$(abspath ../..)
+SRC=$(TOPDIR)
include $(TOPDIR)/Makefile.tools
+include $(TOPDIR)/ocamldoc/Makefile.docfiles
MANUAL=$(TOPDIR)/manual/manual
.PHONY: all
-all: check-cross-references check-stdlib
+all: check-cross-references check-stdlib check-case-collision
.PHONY: tools
tools: cross-reference-checker
-I $(TOPDIR)/parsing -I $(TOPDIR)/driver \
$< -o $@
+# check cross-references between the manual and error messages
.PHONY: check-cross-references
check-cross-references: cross-reference-checker
$(SET_LD_PATH) \
$(TOPDIR)/driver/main_args.ml \
$(TOPDIR)/lambda/translmod.ml
+# check that all standard library modules are referenced by the
+# standard library chapter of the manual
.PHONY: check-stdlib
check-stdlib:
./check-stdlib-modules $(TOPDIR)
+# check name collision between latex source file and module documentation
+# on case-insensitive file systems
+normalize = $(shell echo $(basename $(notdir $(1) )) | tr A-Z a-z)
+LOWER_MLIS= $(call normalize,$(DOC_ALL_MLIS))
+LOWER_ETEX= $(call normalize,$(wildcard $(MANUAL)/*/*.etex) $(wildcard *.etex))
+INTER = $(filter $(LOWER_ETEX), $(LOWER_MLIS))
+
+.PHONY: check-case-collision
+check-case-collision:
+ifeq ($(INTER),)
+else
+ @echo "The following names"
+ @echo " $(INTER)"
+ @echo "are used by both an OCaml module and a latex source file."
+ @echo "This creates a conflict on case-insensitive file systems."
+ @false
+endif
+
+
.PHONY: clean
clean:
rm -f *.cm? *.cmx? cross-reference-checker
| Normal ->
if is_prefix "\\begin{caml_" line || is_prefix "\\begin{rawhtml}" line
then (print_string line; Verbatim_like)
- else if is_prefix "\\camlexample" line
+ else if is_prefix "\\begin{camlexample}" line
then (print_endline line; Caml)
else if is_prefix "\\begin{verbatim}" line
then begin
end
| Caml ->
print_endline line;
- if is_prefix "\\endcamlexample" line then Normal else Caml
+ if is_prefix "\\end{camlexample}" line then Normal else Caml
| Verbatim (verbatim_end_in, verbatim_end_out) as env ->
if is_prefix verbatim_end_in line
then begin
"\\begin{syntax}" {
print_string "\\begin{syntax}";
syntax lexbuf }
- | "\\begin{verbatim}" | "\\camlexample" as s {
+ | "\\begin{verbatim}" | "\\begin{camlexample}" as s {
print_string s;
verbatim lexbuf }
| "\\@" {
indoublequote lexbuf }
and verbatim = parse
- "\n\\end{verbatim}"|"\\endcamlexample" as s {
+ "\n\\end{verbatim}"|"\\end{camlexample}" as s {
print_string s;
main lexbuf }
| _ {
provenance : usymbol_provenance option;
}
+type with_constants =
+ ulambda * preallocated_block list * preallocated_constant list
+
(* Comparison functions for constants. We must not use Stdlib.compare
because it compares "0.0" and "-0.0" equal. (PR#6442) *)
definition : ustructured_constant;
provenance : usymbol_provenance option;
}
+
+type with_constants =
+ ulambda * preallocated_block list * preallocated_constant list
size := !size+2 ;
lambda_size lam)
sw ;
- Misc.may lambda_size d
+ Option.iter lambda_size d
| Ustaticfail (_,args) -> lambda_list_size args
| Ucatch(_, _, body, handler) ->
incr size; lambda_size body; lambda_size handler
Ustringswitch
(substitute loc st sb rn arg,
List.map (fun (s,act) -> s,substitute loc st sb rn act) sw,
- Misc.may_map (substitute loc st sb rn) d)
+ Option.map (substitute loc st sb rn) d)
| Ustaticfail (nfail, args) ->
let nfail =
match rn with
s,uact)
sw in
let ud =
- Misc.may_map
+ Option.map
(fun d ->
let ud,_ = close env d in
ud) d in
| Ustringswitch (u,sw,d) ->
ulam u ;
List.iter (fun (_,act) -> ulam act) sw ;
- Misc.may ulam d
+ Option.iter ulam d
| Ustaticfail (_, ul) -> List.iter ulam ul
| Ucatch (_, _, u1, u2)
| Utrywith (u1, _, u2)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+let raw_clambda_dump_if ppf
+ ((ulambda, _, structured_constants) : Clambda.with_constants) =
+ if !Clflags.dump_rawclambda || !Clflags.dump_clambda then
+ begin
+ Format.fprintf ppf "@.clambda:@.";
+ Printclambda.clambda ppf ulambda;
+ List.iter (fun { Clambda. symbol; definition; _ } ->
+ Format.fprintf ppf "%s:@ %a@."
+ symbol
+ Printclambda.structured_constant definition)
+ structured_constants
+ end;
+ if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@."
+
+let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump
+ (lambda : Lambda.program) =
+ let clambda =
+ Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
+ in
+ let provenance : Clambda.usymbol_provenance =
+ { original_idents = [];
+ module_path =
+ Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ()));
+ }
+ in
+ let preallocated_block =
+ Clambda.{
+ symbol = Compilenv.make_symbol None;
+ exported = true;
+ tag = 0;
+ fields = List.init lambda.main_module_block_size (fun _ -> None);
+ provenance = Some provenance;
+ }
+ in
+ let constants = Compilenv.structured_constants () in
+ Compilenv.clear_structured_constants ();
+ let clambda_and_constants =
+ clambda, [preallocated_block], constants
+ in
+ raw_clambda_dump_if ppf_dump clambda_and_constants;
+ clambda_and_constants
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+val lambda_to_clambda
+ : backend:(module Backend_intf.S)
+ -> filename:string
+ -> prefixname:string
+ -> ppf_dump:Format.formatter
+ -> Lambda.program
+ -> Clambda.with_constants
because it compares "0.0" and "-0.0" equal. *)
end)
+module SymMap = Misc.Stdlib.String.Map
+
type structured_constants =
{
strcst_shared: string CstMap.t;
- strcst_all: (string * Clambda.ustructured_constant) list;
+ strcst_all: Clambda.ustructured_constant SymMap.t;
}
let structured_constants_empty =
{
strcst_shared = CstMap.empty;
- strcst_all = [];
+ strcst_all = SymMap.empty;
}
let structured_constants = ref structured_constants_empty
structured_constants :=
{
strcst_shared = CstMap.add cst lbl strcst_shared;
- strcst_all = (lbl, cst) :: strcst_all;
+ strcst_all = SymMap.add lbl cst strcst_all;
};
lbl
else
structured_constants :=
{
strcst_shared;
- strcst_all = (lbl, cst) :: strcst_all;
+ strcst_all = SymMap.add lbl cst strcst_all;
};
lbl
let clear_structured_constants () =
structured_constants := structured_constants_empty
+let structured_constant_of_symbol s =
+ SymMap.find_opt s (!structured_constants).strcst_all
+
let structured_constants () =
let provenance : Clambda.usymbol_provenance =
{ original_idents = [];
Path.Pident (Ident.create_persistent (current_unit_name ()));
}
in
- List.map
+ SymMap.bindings (!structured_constants).strcst_all
+ |> List.map
(fun (symbol, definition) ->
{
Clambda.symbol;
definition;
provenance = Some provenance;
})
- (!structured_constants).strcst_all
let closure_symbol fv =
let compilation_unit = Closure_id.get_compilation_unit fv in
val structured_constants:
unit -> Clambda.preallocated_constant list
val clear_structured_constants: unit -> unit
+
+val structured_constant_of_symbol:
+ string -> Clambda.ustructured_constant option
+
val add_exported_constant: string -> unit
(* clambda-only *)
type structured_constants
-> What_to_specialise.t
end
-module Make (T : S) : sig
+module Make (_ : S) : sig
(** [duplicate_function] should be
[Inline_and_simplify.duplicate_function]. *)
val rewrite_set_of_closures
val unit : t -> Compilation_unit.t
end
-module Id(E:sig end) : Id = struct
+module Id() : Id = struct
type t = int * string
let empty_string = ""
let create = let r = ref 0 in
val unit : t -> Compilation_unit.t
end
-(** If applied generatively, i.e. [Id(struct end)], creates a new type
- of identifiers. *)
-module Id : functor (E : sig end) -> Id
+module Id () : Id
module UnitId :
- functor (Id : Id) ->
+ Id ->
functor (Compilation_unit : Identifiable.Thing) ->
UnitId with module Compilation_unit := Compilation_unit
consts = List.map aux sw.sw_consts;
numblocks = nums sw.sw_numblocks sw.sw_blocks sw.sw_failaction;
blocks = List.map aux sw.sw_blocks;
- failaction = Misc.may_map (close t env) sw.sw_failaction;
+ failaction = Option.map (close t env) sw.sw_failaction;
}))
| Lstringswitch (arg, sw, def, _) ->
let scrutinee = Variable.create Names.string_switch in
Flambda.create_let scrutinee (Expr (close t env arg))
(String_switch (scrutinee,
List.map (fun (s, e) -> s, close t env e) sw,
- Misc.may_map (close t env) def))
+ Option.map (close t env) def))
| Lstaticraise (i, args) ->
Lift_code.lifting_helper (close_list t env args)
~evaluation_order:`Right_to_left
let aux (_, flam) = no_effects flam in
List.for_all aux sw.blocks
&& List.for_all aux sw.consts
- && Misc.Stdlib.Option.value_default no_effects sw.failaction
- ~default:true
+ && Option.fold ~some:no_effects ~none:true sw.failaction
| String_switch (_, sw, def) ->
List.for_all (fun (_, lam) -> no_effects lam) sw
- && Misc.Stdlib.Option.value_default no_effects def
- ~default:true
+ && Option.fold ~some:no_effects ~none:true def
| Static_catch (_, _, body, _) | Try_with (body, _, _) ->
(* If there is a [raise] in [body], the whole [Try_with] may have an
effect, so there is no need to test the handler. *)
Closure_id.Map.map (import_approx_for_pack units pack)
set_of_closures.results;
aliased_symbol =
- Misc.may_map
+ Option.map
(import_symbol_for_pack units pack)
set_of_closures.aliased_symbol;
}
free_variable scrutinee;
List.iter (fun (_, e) -> aux e) switch.consts;
List.iter (fun (_, e) -> aux e) switch.blocks;
- Misc.may aux switch.failaction
+ Option.iter aux switch.failaction
| String_switch (scrutinee, cases, failaction) ->
free_variable scrutinee;
List.iter (fun (_, e) -> aux e) cases;
- Misc.may aux failaction
+ Option.iter aux failaction
| Static_raise (_, es) ->
List.iter free_variable es
| Static_catch (_, vars, e1, e2) ->
| Switch (_, sw) ->
List.iter (fun (_,l) -> aux l) sw.consts;
List.iter (fun (_,l) -> aux l) sw.blocks;
- Misc.may aux sw.failaction
+ Option.iter aux sw.failaction
| String_switch (_, sw, def) ->
List.iter (fun (_,l) -> aux l) sw;
- Misc.may aux def
+ Option.iter aux def
and aux_named (named : named) =
f_named named;
match named with
This would be true when the function is known never to have
been inlined.
- Note that something like that may maybe enforcable in
+ Note that something like that may maybe enforceable in
inline_and_simplify, but there is no way to do that on other
passes.
ignore_int n;
loop env e)
(consts @ blocks);
- Misc.may (loop env) failaction
+ Option.iter (loop env) failaction
| String_switch (arg, cases, e_opt) ->
check_variable_is_bound env arg;
List.iter (fun (label, case) ->
ignore_string label;
loop env case)
cases;
- Misc.may (loop env) e_opt
+ Option.iter (loop env) e_opt
| Static_raise (static_exn, es) ->
ignore_static_exception static_exn;
List.iter (check_variable_is_bound env) es
| Switch (_, sw) ->
List.iter (fun (_,l) -> f l) sw.consts;
List.iter (fun (_,l) -> f l) sw.blocks;
- Misc.may f sw.failaction
+ Option.iter f sw.failaction
| String_switch (_, sw, def) ->
List.iter (fun (_,l) -> f l) sw;
- Misc.may f def
+ Option.iter f def
| Static_catch (_,_,f1,f2) ->
f f1; f f2;
| Try_with (f1,_,f2) ->
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
-(* Copyright 2014--2016 Jane Street Group LLC *)
+(* Copyright 2014--2019 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* *)
(**************************************************************************)
-[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+[@@@ocaml.warning "+a-4-30-40-41-42-66"]
open! Int_replace_polymorphic_compare
let _dump_function_sizes flam ~backend =
| None -> assert false)
set_of_closures.function_decls.funs)
-let middle_end ~ppf_dump ~prefixname ~backend
- ~size
- ~filename
- ~module_ident
- ~module_initializer =
+let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
+ ~module_ident ~module_initializer =
Profile.record_call "flambda" (fun () ->
let previous_warning_reporter = !Location.warning_reporter in
let module WarningSet =
(* dump_function_sizes flam ~backend; *)
flam))
)
+
+let flambda_raw_clambda_dump_if ppf
+ ({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _;
+ structured_constants; exported = _; } as input) =
+ if !Clflags.dump_rawclambda then
+ begin
+ Format.fprintf ppf "@.clambda (before Un_anf):@.";
+ Printclambda.clambda ppf ulambda;
+ Symbol.Map.iter (fun sym cst ->
+ Format.fprintf ppf "%a:@ %a@."
+ Symbol.print sym
+ Printclambda.structured_constant cst)
+ structured_constants
+ end;
+ if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@.";
+ input
+
+let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump
+ (program : Lambda.program) =
+ let program =
+ lambda_to_flambda ~ppf_dump ~prefixname ~backend
+ ~size:program.main_module_block_size
+ ~filename
+ ~module_ident:program.module_ident
+ ~module_initializer:program.code
+ in
+ let export = Build_export_info.build_transient ~backend program in
+ let clambda, preallocated_blocks, constants =
+ Profile.record_call "backend" (fun () ->
+ (program, export)
+ |> Flambda_to_clambda.convert ~ppf_dump
+ |> flambda_raw_clambda_dump_if ppf_dump
+ |> (fun { Flambda_to_clambda. expr; preallocated_blocks;
+ structured_constants; exported; } ->
+ Compilenv.set_export_info exported;
+ let clambda =
+ Un_anf.apply ~what:(Compilenv.current_unit_symbol ())
+ ~ppf_dump expr
+ in
+ clambda, preallocated_blocks, structured_constants))
+ in
+ let constants =
+ List.map (fun (symbol, definition) ->
+ { Clambda.symbol = Linkage_name.to_string (Symbol.label symbol);
+ exported = true;
+ definition;
+ provenance = None;
+ })
+ (Symbol.Map.bindings constants)
+ in
+ clambda, preallocated_blocks, constants
[@@@ocaml.warning "+a-4-9-30-40-41-42"]
-(* Translate Lambda code to Flambda code and then optimize it. *)
+(** Translate Lambda code to Flambda code, optimize it, and produce Clambda. *)
-val middle_end
- : ppf_dump:Format.formatter
- -> prefixname:string
- -> backend:(module Backend_intf.S)
- -> size:int
+val lambda_to_clambda
+ : backend:(module Backend_intf.S)
-> filename:string
- -> module_ident:Ident.t
- -> module_initializer:Lambda.lambda
- -> Flambda.program
+ -> prefixname:string
+ -> ppf_dump:Format.formatter
+ -> Lambda.program
+ -> Clambda.with_constants
Set_of_closures_id.t for_one_or_more_units;
imported_units :
Simple_value_approx.function_declarations for_one_or_more_units;
+ ppf_dump : Format.formatter;
+ mutable constants_for_instrumentation :
+ Clambda.ustructured_constant Symbol.Map.t;
}
let get_fun_offset t closure_id =
(* Instrumentation of closure and field accesses to try to catch compiler
bugs. *)
-let check_closure ulam named : Clambda.ulambda =
+let check_closure t ulam named : Clambda.ulambda =
if not !Clflags.clambda_checks then ulam
else
let desc =
~arity:2 ~alloc:false
in
let str = Format.asprintf "%a" Flambda.print_named named in
- let str_const =
- Compilenv.new_structured_constant (Uconst_string str) ~shared:true
+ let sym = Compilenv.new_const_symbol () in
+ let sym' =
+ Symbol.of_global_linkage (Compilation_unit.get_current_exn ())
+ (Linkage_name.create sym)
in
+ t.constants_for_instrumentation <-
+ Symbol.Map.add sym' (Clambda.Uconst_string str)
+ t.constants_for_instrumentation;
Uprim (Pccall desc,
- [ulam; Clambda.Uconst (Uconst_ref (str_const, None))],
+ [ulam; Clambda.Uconst (Uconst_ref (sym, None))],
Debuginfo.none)
-let check_field ulam pos named_opt : Clambda.ulambda =
+let check_field t ulam pos named_opt : Clambda.ulambda =
if not !Clflags.clambda_checks then ulam
else
let desc =
| None -> "<none>"
| Some named -> Format.asprintf "%a" Flambda.print_named named
in
- let str_const =
- Compilenv.new_structured_constant (Uconst_string str) ~shared:true
+ let sym = Compilenv.new_const_symbol () in
+ let sym' =
+ Symbol.of_global_linkage (Compilation_unit.get_current_exn ())
+ (Linkage_name.create sym)
in
+ t.constants_for_instrumentation <-
+ Symbol.Map.add sym' (Clambda.Uconst_string str)
+ t.constants_for_instrumentation;
Uprim (Pccall desc, [ulam; Clambda.Uconst (Uconst_int pos);
- Clambda.Uconst (Uconst_ref (str_const, None))],
+ Clambda.Uconst (Uconst_ref (sym, None))],
Debuginfo.none)
module Env : sig
to_clambda_direct_apply t func args direct_func dbg env
| Apply { func; args; kind = Indirect; dbg = dbg } ->
let callee = subst_var env func in
- Ugeneric_apply (check_closure callee (Flambda.Expr (Var func)),
+ Ugeneric_apply (check_closure t callee (Flambda.Expr (Var func)),
subst_vars env args, dbg)
| Switch (arg, sw) ->
let aux () : Clambda.ulambda =
| String_switch (arg, sw, def) ->
let arg = subst_var env arg in
let sw = List.map (fun (s, e) -> s, to_clambda t env e) sw in
- let def = Misc.may_map (to_clambda t env) def in
+ let def = Option.map (to_clambda t env) def in
Ustringswitch (arg, sw, def)
| Static_raise (static_exn, args) ->
Ustaticfail (Static_exception.to_int static_exn,
a [Uoffset] construction in the event that the offset is zero, otherwise
we might break pattern matches in Cmmgen (in particular for the
compilation of "let rec"). *)
- check_closure (
+ check_closure t (
build_uoffset
- (check_closure (subst_var env set_of_closures)
+ (check_closure t (subst_var env set_of_closures)
(Flambda.Expr (Var set_of_closures)))
(get_fun_offset t closure_id))
named
| Move_within_set_of_closures { closure; start_from; move_to } ->
- check_closure (build_uoffset
- (check_closure (subst_var env closure)
+ check_closure t (build_uoffset
+ (check_closure t (subst_var env closure)
(Flambda.Expr (Var closure)))
((get_fun_offset t move_to) - (get_fun_offset t start_from)))
named
let var_offset = get_fv_offset t var in
let pos = var_offset - fun_offset in
Uprim (Pfield pos,
- [check_field (check_closure ulam (Expr (Var closure))) pos (Some named)],
+ [check_field t (check_closure t ulam (Expr (Var closure)))
+ pos (Some named)],
Debuginfo.none)
| Prim (Pfield index, [block], dbg) ->
- Uprim (Pfield index, [check_field (subst_var env block) index None], dbg)
+ Uprim (Pfield index, [check_field t (subst_var env block) index None], dbg)
| Prim (Psetfield (index, maybe_ptr, init), [block; new_value], dbg) ->
Uprim (Psetfield (index, maybe_ptr, init), [
- check_field (subst_var env block) index None;
+ check_field t (subst_var env block) index None;
subst_var env new_value;
], dbg)
| Prim (Popaque, args, dbg) ->
env, id :: params)
function_decl.params (env, [])
in
+ let body =
+ Un_anf.apply ~ppf_dump:t.ppf_dump ~what:symbol
+ (to_clambda t env_body function_decl.body)
+ in
{ label = Compilenv.function_label (Closure_id.wrap id);
arity = Flambda_utils.function_arity function_decl;
params = List.map (fun var -> VP.create var, Lambda.Pgenval) params;
return = Lambda.Pgenval;
- body = to_clambda t env_body function_decl.body;
+ body;
dbg = function_decl.dbg;
env = None;
}
exported : Export_info.t;
}
-let convert (program, exported_transient) : result =
+let convert ~ppf_dump (program, exported_transient) : result =
let current_unit =
let closures =
Closure_id.Map.keys (Flambda_utils.make_closure_map program)
closures;
}
in
- let t = { current_unit; imported_units; } in
+ let t =
+ { current_unit;
+ imported_units;
+ constants_for_instrumentation = Symbol.Map.empty;
+ ppf_dump;
+ }
+ in
let expr, structured_constants, preallocated_blocks =
to_clambda_program t Env.empty Symbol.Map.empty program
in
+ let structured_constants =
+ Symbol.Map.disjoint_union structured_constants
+ t.constants_for_instrumentation
+ in
let exported =
Export_info.t_of_transient exported_transient
~program
For direct calls, the hidden closure parameter is added. Switch
tables are also built.
*)
-val convert : Flambda.program * Export_info.transient -> result
+val convert
+ : ppf_dump:Format.formatter
+ -> Flambda.program * Export_info.transient
+ -> result
mark_var arg curr;
List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.consts;
List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.blocks;
- Misc.may (fun l -> mark_loop ~toplevel [] l) sw.failaction
+ Option.iter (fun l -> mark_loop ~toplevel [] l) sw.failaction
| String_switch (arg,sw,def) ->
mark_curr curr;
mark_var arg curr;
List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw;
- Misc.may (fun l -> mark_loop ~toplevel [] l) def
+ Option.iter (fun l -> mark_loop ~toplevel [] l) def
| Send { kind = _; meth; obj; args; dbg = _; } ->
mark_curr curr;
mark_var meth curr;
let approx =
A.augment_with_symbol (A.value_block tag (Array.of_list approxs)) symbol
in
- let module Backend = (val (E.backend env) : Backend_intf.S) in
let env = E.add_symbol env symbol approx in
let program, r = simplify_program_body env r program in
Initialize_symbol (symbol, tag, fields, program), r
size := !size + 2;
lambda_size lam)
sw;
- Misc.may lambda_size def
+ Option.iter lambda_size def
| Static_raise _ -> ()
| Static_catch (_, _, body, handler) ->
incr size; lambda_size body; lambda_size handler
type lifter = Flambda.program -> Flambda.program
-let rebuild_let
- (defs : (Variable.t * Flambda.named Flambda.With_free_variables.t) list)
- (body : Flambda.t) =
+type def =
+ | Immutable of Variable.t * Flambda.named Flambda.With_free_variables.t
+ | Mutable of Mutable_variable.t * Variable.t * Lambda.value_kind
+
+let rebuild_let (defs : def list) (body : Flambda.t) =
let module W = Flambda.With_free_variables in
- List.fold_left (fun body (var, def) ->
- W.create_let_reusing_defining_expr var def body)
+ List.fold_left (fun body def ->
+ match def with
+ | Immutable(var, def) ->
+ W.create_let_reusing_defining_expr var def body
+ | Mutable(var, initial_value, contents_kind) ->
+ Flambda.Let_mutable {var; initial_value; contents_kind; body})
body defs
-let rec extract_lets
- (acc:(Variable.t * Flambda.named Flambda.With_free_variables.t) list)
- (let_expr:Flambda.let_expr) :
- (Variable.t * Flambda.named Flambda.With_free_variables.t) list *
- Flambda.t Flambda.With_free_variables.t =
+let rec extract_let_expr (acc:def list) (let_expr:Flambda.let_expr) :
+ def list * Flambda.t Flambda.With_free_variables.t =
+ let module W = Flambda.With_free_variables in
+ let acc =
+ match let_expr with
+ | { var = v1; defining_expr = Expr (Let let2); _ } ->
+ let acc, body2 = extract_let_expr acc let2 in
+ Immutable(v1, W.expr body2) :: acc
+ | { var = v1; defining_expr = Expr (Let_mutable let_mut); _ } ->
+ let acc, body2 = extract_let_mutable acc let_mut in
+ Immutable(v1, W.expr body2) :: acc
+ | { var = v; _ } ->
+ Immutable(v, W.of_defining_expr_of_let let_expr) :: acc
+ in
+ let body = W.of_body_of_let let_expr in
+ extract acc body
+
+and extract_let_mutable acc (let_mut : Flambda.let_mutable) =
let module W = Flambda.With_free_variables in
- match let_expr with
- | { var = v1; defining_expr = Expr (Let let2); _ } ->
- let acc, body2 = extract_lets acc let2 in
- let acc = (v1, W.expr body2) :: acc in
- let body = W.of_body_of_let let_expr in
- extract acc body
- | { var = v; _ } ->
- let acc = (v, W.of_defining_expr_of_let let_expr) :: acc in
- let body = W.of_body_of_let let_expr in
- extract acc body
+ let { Flambda.var; initial_value; contents_kind; body } = let_mut in
+ let acc = Mutable(var, initial_value, contents_kind) :: acc in
+ extract acc (W.of_expr body)
and extract acc (expr : Flambda.t Flambda.With_free_variables.t) =
let module W = Flambda.With_free_variables in
match W.contents expr with
| Let let_expr ->
- extract_lets acc let_expr
+ extract_let_expr acc let_expr
+ | Let_mutable let_mutable ->
+ extract_let_mutable acc let_mutable
| _ ->
acc, expr
let module W = Flambda.With_free_variables in
match expr with
| Let let_expr ->
- let defs, body = extract_lets [] let_expr in
- let rev_defs =
- List.rev_map (lift_lets_named_with_free_variables ~toplevel) defs
- in
+ let defs, body = extract_let_expr [] let_expr in
+ let rev_defs = List.rev_map (lift_lets_def ~toplevel) defs in
+ let body = lift_lets_expr (W.contents body) ~toplevel in
+ rebuild_let (List.rev rev_defs) body
+ | Let_mutable let_mut ->
+ let defs, body = extract_let_mutable [] let_mut in
+ let rev_defs = List.rev_map (lift_lets_def ~toplevel) defs in
let body = lift_lets_expr (W.contents body) ~toplevel in
rebuild_let (List.rev rev_defs) body
| e ->
(lift_lets_named ~toplevel)
e
-and lift_lets_named_with_free_variables
- ((var, named):Variable.t * Flambda.named Flambda.With_free_variables.t)
- ~toplevel : Variable.t * Flambda.named Flambda.With_free_variables.t =
+and lift_lets_def def ~toplevel =
let module W = Flambda.With_free_variables in
- match W.contents named with
- | Expr e ->
- var, W.expr (W.of_expr (lift_lets_expr e ~toplevel))
- | Set_of_closures set when not toplevel ->
- var,
- W.of_named
- (Set_of_closures
- (Flambda_iterators.map_function_bodies
- ~f:(lift_lets_expr ~toplevel) set))
- | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
- | Read_symbol_field (_, _) | Project_closure _ | Move_within_set_of_closures _
- | Project_var _ | Prim _ | Set_of_closures _ ->
- var, named
+ match def with
+ | Mutable _ -> def
+ | Immutable(var, named) ->
+ let named =
+ match W.contents named with
+ | Expr e -> W.expr (W.of_expr (lift_lets_expr e ~toplevel))
+ | Set_of_closures set when not toplevel ->
+ W.of_named
+ (Set_of_closures
+ (Flambda_iterators.map_function_bodies
+ ~f:(lift_lets_expr ~toplevel) set))
+ | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+ | Read_symbol_field (_, _) | Project_closure _
+ | Move_within_set_of_closures _ | Project_var _
+ | Prim _ | Set_of_closures _ ->
+ named
+ in
+ Immutable(var, named)
and lift_lets_named _var (named:Flambda.named) ~toplevel : Flambda.named =
- let module W = Flambda.With_free_variables in
match named with
| Expr e ->
Expr (lift_lets_expr e ~toplevel)
set := Variable.Set.add cond !set;
List.iter (fun (_, branch) -> loop branch) consts;
List.iter (fun (_, branch) -> loop branch) blocks;
- Misc.may loop failaction
+ Option.iter loop failaction
| String_switch (cond, branches, default) ->
set := Variable.Set.add cond !set;
List.iter (fun (_, branch) -> loop branch) branches;
- Misc.may loop default
+ Option.iter loop default
| Static_catch (_, _, body, handler) ->
loop body;
loop handler
let approx_set_of_closures =
{ descr = Value_set_of_closures value_set_of_closures;
var = set_of_closures_var;
- symbol = Misc.may_map (fun s -> s, None) set_of_closures_symbol;
+ symbol = Option.map (fun s -> s, None) set_of_closures_symbol;
}
in
let value_closure =
ignore_string str;
loop branch)
branches;
- Misc.may loop default
+ Option.iter loop default
| Ustaticfail (static_exn, args) ->
ignore_int static_exn;
List.iter loop args
loop branch)
branches;
let_stack := [];
- Misc.may loop default;
+ Option.iter loop default;
let_stack := []
| Ustaticfail (static_exn, args) ->
ignore_int static_exn;
branches
in
let default =
- Misc.may_map (substitute_let_moveable is_let_moveable env) default
+ Option.map (substitute_let_moveable is_let_moveable env) default
in
Ustringswitch (cond, branches, default)
| Ustaticfail (n, args) ->
List.map (fun (s, branch) -> s, un_anf var_info env branch)
branches
in
- let default = Misc.may_map (un_anf var_info env) default in
+ let default = Option.map (un_anf var_info env) default in
Ustringswitch (cond, branches, default), Fixed
| Ustaticfail (n, args) ->
let args = un_anf_list var_info env args in
and un_anf_array var_info env clams : Clambda.ulambda array =
Array.map (un_anf var_info env) clams
-let apply ~ppf_dump clam ~what =
+let apply ~what ~ppf_dump clam =
let var_info = make_var_info clam in
let let_bound_vars_that_can_be_moved =
let_bound_vars_that_can_be_moved var_info clam
let clam = un_anf var_info V.Map.empty clam in
if !Clflags.dump_clambda then begin
Format.fprintf ppf_dump
- "@.un-anf (%s):@ %a@." what Printclambda.clambda clam
+ "@.un-anf (%a):@ %a@."
+ Symbol.print what
+ Printclambda.clambda clam
end;
clam
(** Expand ANF-like constructs so that pattern matches in [Cmmgen] will
work correctly. *)
val apply
- : ppf_dump:Format.formatter
+ : what:Symbol.t
+ -> ppf_dump:Format.formatter
-> Clambda.ulambda
- -> what:string
-> Clambda.ulambda
opam-version: "2.0"
-version: "4.09.1"
+version: "4.10.0"
synopsis: "OCaml development version"
depends: [
- "ocaml" {= "4.09.1" & post}
+ "ocaml" {= "4.10.0" & post}
"base-unix" {post}
"base-bigarray" {post}
"base-threads" {post}
setenv: CAML_LD_LIBRARY_PATH = "%{lib}%/stublibs"
build: [
["./configure" "--prefix=%{prefix}%"]
- [make "-j%{jobs}%" "world"]
- [make "-j%{jobs}%" "world.opt"]
+ [make "-j%{jobs}%"]
]
install: [make "install"]
maintainer: "caml-list@inria.fr"
odoc_module.cmo \
odoc_global.cmi
odoc_args.cmo : \
- ../utils/warnings.cmi \
odoc_types.cmi \
odoc_texi.cmo \
odoc_messages.cmo \
odoc_config.cmi \
../driver/main_args.cmi \
../utils/config.cmi \
- ../driver/compenv.cmi \
- ../utils/clflags.cmi \
odoc_args.cmi
odoc_args.cmx : \
- ../utils/warnings.cmx \
odoc_types.cmx \
odoc_texi.cmx \
odoc_messages.cmx \
odoc_config.cmx \
../driver/main_args.cmx \
../utils/config.cmx \
- ../driver/compenv.cmx \
- ../utils/clflags.cmx \
odoc_args.cmi
odoc_args.cmi : \
odoc_gen.cmi
odoc_exception.cmo \
odoc_env.cmi \
odoc_class.cmo \
- ../utils/misc.cmi \
../parsing/location.cmi \
../typing/ident.cmi \
../parsing/asttypes.cmi \
odoc_exception.cmx \
odoc_env.cmx \
odoc_class.cmx \
- ../utils/misc.cmx \
../parsing/location.cmx \
../typing/ident.cmx \
../parsing/asttypes.cmi \
../typing/predef.cmi \
../typing/path.cmi \
odoc_name.cmi \
- ../utils/misc.cmi \
../typing/btype.cmi \
odoc_env.cmi
odoc_env.cmx : \
../typing/predef.cmx \
../typing/path.cmx \
odoc_name.cmx \
- ../utils/misc.cmx \
../typing/btype.cmx \
odoc_env.cmi
odoc_env.cmi : \
odoc_misc.cmi \
odoc_messages.cmo \
odoc_info.cmi \
- ../utils/misc.cmi \
../parsing/asttypes.cmi
odoc_man.cmx : \
odoc_str.cmx \
odoc_misc.cmx \
odoc_messages.cmx \
odoc_info.cmx \
- ../utils/misc.cmx \
../parsing/asttypes.cmi
odoc_merge.cmo : \
odoc_value.cmo \
odoc_print.cmo : \
../typing/types.cmi \
../typing/printtyp.cmi \
- ../utils/misc.cmi \
../typing/btype.cmi \
odoc_print.cmi
odoc_print.cmx : \
../typing/types.cmx \
../typing/printtyp.cmx \
- ../utils/misc.cmx \
../typing/btype.cmx \
odoc_print.cmi
odoc_print.cmi : \
odoc_types.cmi \
odoc_type.cmo \
odoc_module.cmo \
+ odoc_misc.cmi \
odoc_extension.cmo \
odoc_exception.cmo \
odoc_class.cmo \
odoc_types.cmx \
odoc_type.cmx \
odoc_module.cmx \
+ odoc_misc.cmx \
odoc_extension.cmx \
odoc_exception.cmx \
odoc_class.cmx \
odoc_exception.cmo \
odoc_env.cmi \
odoc_class.cmo \
- ../utils/misc.cmi \
../parsing/longident.cmi \
../parsing/location.cmi \
../typing/ident.cmi \
odoc_exception.cmx \
odoc_env.cmx \
odoc_class.cmx \
- ../utils/misc.cmx \
../parsing/longident.cmx \
../parsing/location.cmx \
../typing/ident.cmx \
include $(ROOTDIR)/Makefile.config
include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc
STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc $(STDLIBFLAGS)
-OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt $(STDLIBFLAGS)
-OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend
+OCAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
+OCAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS)
+OCAMLDEP = $(BEST_OCAMLDEP)
DEPFLAGS = -slash
-OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
+OCAMLLEX = $(BEST_OCAMLLEX)
+
# TODO: figure out whether the DEBUG lines the following preprocessor removes
# are actually useful.
# If they are not, then the preprocessor logic (including the
MKDIR=mkdir -p
CP=cp
OCAMLDOC=ocamldoc
+OCAMLDOC_OPT=$(OCAMLDOC).opt
# TODO: clarify whether the following really needs to be that complicated
ifeq "$(UNIX_OR_WIN32)" "unix"
ifeq "$(TARGET)" "$(HOST)"
ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
- OCAMLDOC_RUN=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
+ OCAMLDOC_RUN_BYTE=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
else
- OCAMLDOC_RUN=./$(OCAMLDOC)
+# if shared-libraries are not supported, unix.cma and str.cma
+# are compiled with -custom, so ocamldoc also uses -custom,
+# and (ocamlrun ocamldoc) does not work.
+ OCAMLDOC_RUN_BYTE=./$(OCAMLDOC)
endif
else
- OCAMLDOC_RUN=$(OCAMLRUN) ./$(OCAMLDOC)
+ OCAMLDOC_RUN_BYTE=$(OCAMLRUN) ./$(OCAMLDOC)
endif
else # Windows
- OCAMLDOC_RUN = \
+ OCAMLDOC_RUN_BYTE = \
CAML_LD_LIBRARY_PATH="$(ROOTDIR)/otherlibs/win32unix;$(ROOTDIR)/otherlibs/str" $(OCAMLRUN) ./$(OCAMLDOC)
endif
-OCAMLDOC_OPT=$(OCAMLDOC).opt
+OCAMLDOC_RUN_OPT=./$(OCAMLDOC_OPT)
+
+OCAMLDOC_RUN_PLUGINS=$(OCAMLDOC_RUN_BYTE)
+
+ifeq "$(wildcard $(OCAMLDOC_OPT))" ""
+ OCAMLDOC_RUN=$(OCAMLDOC_RUN_BYTE)
+else
+ OCAMLDOC_RUN=$(OCAMLDOC_RUN_OPT)
+endif
+
OCAMLDOC_LIBCMA=odoc_info.cma
OCAMLDOC_LIBCMI=odoc_info.cmi
OCAMLDOC_LIBCMXA=odoc_info.cmxa
DEPINCLUDES=$(INCLUDES_DEP)
INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
-COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A -safe-string -strict-sequence -strict-formats -bin-annot
+COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+ -safe-string -strict-sequence -strict-formats -bin-annot -principal
+
LINKFLAGS=$(INCLUDES) -nostdlib
CMOFILES=\
LIBCMXFILES = $(LIBCMOFILES:.cmo=.cmx)
LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi)
+ifeq "$(STDLIB_MANPAGES)" "true"
+DOCS_TARGET = manpages
+else
+DOCS_TARGET =
+endif
.PHONY: all
-all: lib exe generators manpages
-
-manpages: generators
+all: lib exe generators $(DOCS_TARGET)
.PHONY: exe
exe: $(OCAMLDOC)
$(OCAMLOPT_CMD) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $<
.mll.ml:
- $(OCAMLLEX) $<
+ $(OCAMLLEX) $(OCAMLLEX_FLAGS) $<
.mly.ml:
$(OCAMLYACC) --strict -v $<
$(MKDIR) $@
$(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc odoc*.ml odoc*.mli -v
$(MKDIR) $@-custom
- $(OCAMLDOC_RUN) -colorize-code -sort -d $@-custom $(INCLUDES) \
+ $(OCAMLDOC_RUN_PLUGINS) -colorize-code -sort -d $@-custom $(INCLUDES) \
-g generators/odoc_literate.cmo -g generators/odoc_todo.cmo \
-load $@/ocamldoc.odoc -v
$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.ml \
$(ROOTDIR)/otherlibs/str/str.ml
-.PHONY: test_framed
-test_framed:
- $(MKDIR) $@
- $(OCAMLDOC_RUN) -g odoc_fhtml.cmo -sort -colorize-code -d $@ $(INCLUDES) odoc*.ml odoc*.mli
-
.PHONY: test_latex
test_latex:
$(MKDIR) $@
.PHONY: autotest_stdlib
autotest_stdlib:
$(MKDIR) $@
- $(OCAMLDOC_RUN) -g autotest/odoc_test.cmo\
+ $(OCAMLDOC_RUN_PLUGINS) -g autotest/odoc_test.cmo\
$(INCLUDES) -keep-code \
$(ROOTDIR)/stdlib/*.mli \
$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.mli \
depend:
$(OCAMLYACC) odoc_text_parser.mly
$(OCAMLYACC) odoc_parser.mly
- $(OCAMLLEX) odoc_text_lexer.mll
- $(OCAMLLEX) odoc_lexer.mll
- $(OCAMLLEX) odoc_ocamlhtml.mll
- $(OCAMLLEX) odoc_see_lexer.mll
+ $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_text_lexer.mll
+ $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_lexer.mll
+ $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_ocamlhtml.mll
+ $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_see_lexer.mll
$(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mll *.mly *.ml *.mli > .depend
$(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) -shared generators/*.ml >> .depend
Odoc_global.files := !Odoc_global.files @ [sf]
module Options = Main_args.Make_ocamldoc_options(struct
- let set r () = r := true
- let unset r () = r := false
- let _absname = set Clflags.absname
- let _alert = Warnings.parse_alert_option
- let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs
- let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
- let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
- let _intf_suffix s = Config.interface_suffix := s
- let _labels = unset Clflags.classic
- let _alias_deps = unset Clflags.transparent_modules
- let _no_alias_deps = set Clflags.transparent_modules
- let _app_funct = set Clflags.applicative_functors
- let _no_app_funct = unset Clflags.applicative_functors
- let _noassert = set Clflags.noassert
- let _nolabels = set Clflags.classic
- let _nostdlib = set Clflags.no_std_include
- let _open s = Clflags.open_modules := s :: !Clflags.open_modules
- let _pp s = Clflags.preprocessor := Some s
- let _ppx s = Clflags.all_ppx := s :: !Clflags.all_ppx
- let _principal = set Clflags.principal
- let _no_principal = unset Clflags.principal
- let _rectypes = set Clflags.recursive_types
- let _no_rectypes = unset Clflags.recursive_types
- let _safe_string = unset Clflags.unsafe_string
- let _short_paths = unset Clflags.real_paths
- let _strict_sequence = set Clflags.strict_sequence
- let _no_strict_sequence = unset Clflags.strict_sequence
- let _strict_formats = set Clflags.strict_formats
- let _no_strict_formats = unset Clflags.strict_formats
- let _thread = set Clflags.use_threads
- let _vmthread = ignore
- let _unboxed_types = set Clflags.unboxed_types
- let _no_unboxed_types = unset Clflags.unboxed_types
- let _unsafe () = assert false
- let _unsafe_string = set Clflags.unsafe_string
- let _v () = Compenv.print_version_and_library "documentation generator"
- let _version = Compenv.print_version_string
- let _vnum = Compenv.print_version_string
- let _w = (Warnings.parse_options false)
- let _warn_error _ = assert false
- let _warn_help _ = assert false
- let _where = Compenv.print_standard_library
- let _verbose = set Clflags.verbose
- let _nopervasives = set Clflags.nopervasives
- let _dno_unique_ids = unset Clflags.unique_ids
- let _dunique_ids = set Clflags.unique_ids
- let _dsource = set Clflags.dump_source
- let _dparsetree = set Clflags.dump_parsetree
- let _dtypedtree = set Clflags.dump_typedtree
- let _drawlambda = set Clflags.dump_rawlambda
- let _dlambda = set Clflags.dump_lambda
- let _dflambda = set Clflags.dump_flambda
- let _dinstr = set Clflags.dump_instr
- let _dcamlprimc = set Clflags.keep_camlprimc_file
- let anonymous = anonymous
+ include Main_args.Default.Odoc_args
+ let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs
+ let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
+ let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
end)
(** The default option list *)
(**************************************************************************)
(** Analysis of implementation files. *)
-open Misc
open Asttypes
open Types
open Typedtree
let add_to_hashes table table_values tt =
match tt with
| Typedtree.Tstr_module mb ->
- Hashtbl.add table (M (Name.from_ident mb.mb_id)) tt
+ Option.iter (fun id ->
+ Hashtbl.add table (M (Name.from_ident id)) tt) mb.mb_id
| Typedtree.Tstr_recmodule mods ->
List.iter
(fun mb ->
- Hashtbl.add table (M (Name.from_ident mb.mb_id))
- (Typedtree.Tstr_module mb)
+ Option.iter (fun id ->
+ Hashtbl.add table (M (Name.from_ident id))
+ (Typedtree.Tstr_module mb)
+ ) mb.mb_id
)
mods
| Typedtree.Tstr_modtype mtd ->
xt_name = complete_name;
xt_args;
xt_ret =
- may_map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) ret_type;
+ Option.map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) ret_type;
xt_type_extension = new_te;
xt_alias = None;
xt_loc = { loc_impl = Some tt_ext.ext_loc ; loc_inter = None } ;
ex_info = comment_opt ;
ex_args;
ex_ret =
- Misc.may_map
+ Option.map
(fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type)
tt_ret_type;
ex_alias = None ;
in
(0, new_env, [ Element_exception new_ext ])
- | Parsetree.Pstr_module {Parsetree.pmb_name=name; pmb_expr=module_expr} ->
+ | Parsetree.Pstr_module {Parsetree.pmb_name={txt=None}} ->
+ (0, env, [])
+
+ | Parsetree.Pstr_module {Parsetree.pmb_name={txt=Some name}; pmb_expr=module_expr} ->
(
(* of string * module_expr *)
try
- let tt_module_expr = Typedtree_search.search_module table name.txt in
+ let tt_module_expr = Typedtree_search.search_module table name in
let new_module_pre = analyse_module
env
current_module_name
- name.txt
+ name
comment_opt
module_expr
tt_module_expr
(0, new_env2, [ Element_module new_module ])
with
Not_found ->
- let complete_name = Name.concat current_module_name name.txt in
+ let complete_name = Name.concat current_module_name name in
raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
)
let new_env =
List.fold_left
(fun acc_env {Parsetree.pmb_name=name;pmb_expr=mod_exp} ->
- let complete_name = Name.concat current_module_name name.txt in
- let e = Odoc_env.add_module acc_env complete_name in
- let tt_mod_exp =
- try Typedtree_search.search_module table name.txt
- with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
- in
- let new_module = analyse_module
- e
- current_module_name
- name.txt
- None
- mod_exp
- tt_mod_exp
- in
- match new_module.m_type with
- Types.Mty_signature s ->
- Odoc_env.add_signature e new_module.m_name
- ~rel: (Name.simple new_module.m_name) s
- | _ ->
- e
+ match name.txt with
+ | None -> acc_env
+ | Some name ->
+ let complete_name = Name.concat current_module_name name in
+ let e = Odoc_env.add_module acc_env complete_name in
+ let tt_mod_exp =
+ try Typedtree_search.search_module table name
+ with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
+ in
+ let new_module = analyse_module
+ e
+ current_module_name
+ name
+ None
+ mod_exp
+ tt_mod_exp
+ in
+ match new_module.m_type with
+ Types.Mty_signature s ->
+ Odoc_env.add_signature e new_module.m_name
+ ~rel: (Name.simple new_module.m_name) s
+ | _ ->
+ e
)
env
mods
let rec f ?(first=false) last_pos name_mod_exp_list =
match name_mod_exp_list with
[] -> []
- | {Parsetree.pmb_name=name;pmb_expr=mod_exp} :: q ->
- let complete_name = Name.concat current_module_name name.txt in
+ | {Parsetree.pmb_name={txt=None};pmb_expr=mod_exp} :: q ->
+ let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
+ let loc_end = mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
+ let (_, ele_comments) = (* the comment for the first type was already retrieved *)
+ if first then
+ (None, [])
+ else
+ get_comments_in_module last_pos loc_start
+ in
+ let eles = f loc_end q in
+ ele_comments @ eles
+ | {Parsetree.pmb_name={txt=Some name};pmb_expr=mod_exp} :: q ->
+ let complete_name = Name.concat current_module_name name in
let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
let tt_mod_exp =
- try Typedtree_search.search_module table name.txt
+ try Typedtree_search.search_module table name
with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
in
let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *)
let new_module = analyse_module
new_env
current_module_name
- name.txt
+ name
com_opt
mod_exp
tt_mod_exp
let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
{ m_base with m_kind = Module_struct elements2 }
- | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2),
- Typedtree.Tmod_functor (ident, _, mtyp, tt_module_expr2)) ->
- let loc = match pmodule_type with None -> Location.none
- | Some pmty -> pmty.Parsetree.pmty_loc in
+ | (Parsetree.Pmod_functor (param2, p_module_expr2),
+ Typedtree.Tmod_functor (param, tt_module_expr2)) ->
+ let loc, mp_name, mp_kind, mp_type =
+ match param2, param with
+ | Parsetree.Unit, Typedtree.Unit ->
+ Location.none, "*", Module_type_struct [], None
+ | Parsetree.Named (_, pmty), Typedtree.Named (ident, _, mty) ->
+ let loc = pmty.Parsetree.pmty_loc in
+ let mp_name = Option.fold ~none:"*" ~some:Name.from_ident ident in
+ let mp_kind =
+ Sig.analyse_module_type_kind env current_module_name pmty
+ mty.mty_type
+ in
+ let mp_type = Odoc_env.subst_module_type env mty.mty_type in
+ loc, mp_name, mp_kind, Some mp_type
+ | _, _ -> assert false
+ in
let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
let mp_type_code = get_string_of_file loc_start loc_end in
print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
- let mp_name = Name.from_ident ident in
- let mp_kind =
- match pmodule_type, mtyp with
- Some pmty, Some mty ->
- Sig.analyse_module_type_kind env current_module_name pmty
- mty.mty_type
- | _ -> Module_type_struct []
- in
let param =
{
- mp_name = mp_name ;
- mp_type = Misc.may_map
- (fun m -> Odoc_env.subst_module_type env m.mty_type) mtyp ;
+ mp_name ;
+ mp_type ;
mp_type_code = mp_type_code ;
- mp_kind = mp_kind ;
+ mp_kind ;
}
in
let dummy_complete_name = (*Name.concat "__"*) param.mp_name in
The module uses the module {!Odoc_sig.Analyser}.
@param My_ir The module used to retrieve comments and special comments.*)
module Analyser :
- functor (My_ir : Odoc_sig.Info_retriever) ->
+ Odoc_sig.Info_retriever ->
sig
(** This function takes a file name, a file containing the code and
the typed tree obtained from the compiler.
let subst_module_type env t =
let rec iter t =
+ let open Types in
match t with
- Types.Mty_ident p ->
+ Mty_ident p ->
let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
- Types.Mty_ident new_p
- | Types.Mty_alias _
- | Types.Mty_signature _ ->
+ Mty_ident new_p
+ | Mty_alias _
+ | Mty_signature _ ->
t
- | Types.Mty_functor (id, mt1, mt2) ->
- Types.Mty_functor (id, Misc.may_map iter mt1, iter mt2)
+ | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt)
+ | Mty_functor (Named (name, mt1), mt2) ->
+ Mty_functor (Named (name, iter mt1), iter mt2)
in
iter t
class generator : doc_generator = object method generate _ = () end
end;;
-module type Base_functor = functor (G: Base) -> Base
-module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator
-module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator
-module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator
-module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator
-module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator
+module type Base_functor = Base -> Base
+module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator
+module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator
+module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator
+module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator
+module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator
type generator =
| Html of (module Odoc_html.Html_generator)
module Base_generator : Base
-module type Base_functor = functor (P: Base) -> Base
-module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator
-module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator
-module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator
-module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator
-module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator
+module type Base_functor = Base -> Base
+module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator
+module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator
+module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator
+module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator
+module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator
(** Various ways to create a generator. *)
type generator =
bs b "\n</tr>"
in
print_concat b "\n" print_one l;
- bs b "</table>\n}\n"
+ bs b "</table>\n<code>}</code>\n"
(** Print html code for a type. *)
method man_of_text_element b txt =
match txt with
| Odoc_info.Raw s -> bs b (self#escape s)
- | Odoc_info.Code s ->
- bs b "\n.B ";
- bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n")
+ | Odoc_info.Code s -> self#man_of_code b s
| Odoc_info.CodePre s ->
- bs b "\n.B ";
- bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n")
+ bs b "\n.EX";
+ self#man_of_code b s;
+ bs b "\n.EE";
| Odoc_info.Verbatim s ->
bs b (self#escape s)
| Odoc_info.Bold t
if String.lowercase_ascii target = "man" then bs b code else ()
(** Print groff string to display code. *)
- method man_of_code b s = self#man_of_text b [ Code s ]
+ method man_of_code b code =
+ let code = self#escape code in
+ bs b "\n.ft B\n";
+ bs b (Str.global_replace (Str.regexp "\n") "\n.br\n\\&" code);
+ bs b "\n.ft R\n";
(** Take a string and return the string where fully qualified idents
have been replaced by idents relative to the given module name.*)
(fun (p, desc_opt) ->
bs b ".sp\n";
bs b ("\""^p.mp_name^"\"\n");
- Misc.may (self#man_of_module_type b m_name) p.mp_type;
+ Option.iter (self#man_of_module_type b m_name) p.mp_type;
bs b "\n";
(
match desc_opt with
in
iter
+let remove_duplicates (type a) compare (li : a list) =
+ let module S = Set.Make(struct type t = a let compare = compare end) in
+ let maybe_cons ((set, rev_acc) as acc) x =
+ if S.mem x set then acc
+ else (S.add x set, x :: rev_acc) in
+ let (_, rev_acc) = List.fold_left maybe_cons (S.empty, []) li in
+ List.rev rev_acc
+
let rec string_of_longident li =
match li with
| Longident.Lident s -> s
begin with a letter should be in the first returned list.*)
val create_index_lists : 'a list -> ('a -> string) -> 'a list list
+(** [remove_duplicates compare li] removes the duplicates in the input list,
+ keeping the leftmost occurrence of each repeated element. *)
+val remove_duplicates : ('a -> 'a -> int) -> 'a list -> 'a list
+
(** [remove_ending_newline s] returns [s] without the optional ending newline. *)
val remove_ending_newline : string -> string
than the "emptied" type.
*)
let simpl_module_type ?code t =
+ let open Types in
let rec iter t =
match t with
- Types.Mty_ident _
- | Types.Mty_alias _ -> t
- | Types.Mty_signature _ ->
+ Mty_ident _
+ | Mty_alias _ -> t
+ | Mty_signature _ ->
(
match code with
- None -> Types.Mty_signature []
+ None -> Mty_signature []
| Some s -> raise (Use_code s)
)
- | Types.Mty_functor (id, mt1, mt2) ->
- Types.Mty_functor (id, Misc.may_map iter mt1, iter mt2)
+ | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt)
+ | Mty_functor (Named (name, mt1), mt2) ->
+ Mty_functor (Named (name, iter mt1), iter mt2)
in
iter t
l
and search module_list v =
- List.fold_left
- (fun acc -> fun m ->
- List.fold_left
- (fun acc2 -> fun ele ->
- if List.mem ele acc2 then acc2 else acc2 @ [ele]
- )
- acc
- (search_module m v)
- )
- []
- module_list
+ let results_with_duplicates =
+ List.fold_left
+ (fun rev_acc m ->
+ List.rev_append (search_module m v) rev_acc)
+ [] module_list
+ |> List.rev
+ in
+ Odoc_misc.remove_duplicates Stdlib.compare results_with_duplicates
end
module P_name =
(** Analysis of interface files. *)
-open Misc
open Asttypes
open Types
{
vc_name = constructor_name ;
vc_args;
- vc_ret = may_map (Odoc_env.subst_type env) ret_type;
+ vc_ret = Option.map (Odoc_env.subst_type env) ret_type;
vc_text = comment_opt
}
in
| [] -> acc
| types -> take_item (Parsetree.Psig_type (rf, types)))
| Parsetree.Psig_modsubst _ -> acc
- | Parsetree.Psig_module ({Parsetree.pmd_name=name;
+ | Parsetree.Psig_module {Parsetree.pmd_name={ txt = None }} -> acc
+ | Parsetree.Psig_module ({Parsetree.pmd_name={txt = Some name };
pmd_type=module_type} as r)
as m ->
- begin match Name.Map.find name.txt erased with
+ begin match Name.Map.find name erased with
| exception Not_found -> take_item m
| `Removed -> acc
| `Constrained constraints ->
| Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
if is_erased name.txt erased then acc else take_item m
| Parsetree.Psig_recmodule mods ->
- (match List.filter (fun pmd -> not (is_erased pmd.Parsetree.pmd_name.txt erased)) mods with
- | [] -> acc
- | mods -> take_item (Parsetree.Psig_recmodule mods)))
+ (match List.filter
+ (fun pmd ->
+ match pmd.Parsetree.pmd_name.txt with
+ | None -> false
+ | Some name -> not (is_erased name erased))
+ mods
+ with
+ | [] -> acc
+ | mods -> take_item (Parsetree.Psig_recmodule mods)))
signature []
(** Analysis of the elements of a class, from the information in the parsetree and in the class
{
xt_name = Name.concat current_module_name name ;
xt_args;
- xt_ret = may_map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ;
+ xt_ret = Option.map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ;
xt_type_extension = new_te;
xt_alias = None ;
xt_loc = { loc_impl = None ; loc_inter = Some types_ext.Types.ext_loc} ;
ex_name = Name.concat current_module_name name.txt ;
ex_info = comment_opt ;
ex_args;
- ex_ret = may_map (Odoc_env.subst_type env) types_ext.ext_ret_type ;
+ ex_ret = Option.map (Odoc_env.subst_type env) types_ext.ext_ret_type ;
ex_alias = None ;
ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
ex_code =
| Parsetree.Psig_modsubst _ -> (* FIXME *)
(0, env, [])
- | Parsetree.Psig_module {Parsetree.pmd_name=name; pmd_type=module_type} ->
- let complete_name = Name.concat current_module_name name.txt in
+ | Parsetree.Psig_module {Parsetree.pmd_name={txt=None}} ->
+ (0, env, [])
+
+ | Parsetree.Psig_module {Parsetree.pmd_name={txt=Some name}; pmd_type=module_type} ->
+ let complete_name = Name.concat current_module_name name in
(* get the module type in the signature by the module name *)
let sig_module_type =
- try Signature_search.search_module table name.txt
+ try Signature_search.search_module table name
with Not_found ->
- raise (Failure (Odoc_messages.module_not_found current_module_name name.txt))
+ raise (Failure (Odoc_messages.module_not_found current_module_name name))
in
let module_kind = analyse_module_kind env complete_name module_type sig_module_type in
let code_intf =
let new_env =
List.fold_left
(fun acc_env {Parsetree.pmd_name={txt=name}} ->
- let complete_name = Name.concat current_module_name name in
- let e = Odoc_env.add_module acc_env complete_name in
- (* get the information for the module in the signature *)
- let sig_module_type =
- try Signature_search.search_module table name
- with Not_found ->
- raise (Failure (Odoc_messages.module_not_found current_module_name name))
- in
- match sig_module_type with
- (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
- Types.Mty_signature s ->
- Odoc_env.add_signature e complete_name ~rel: name s
- | _ ->
- print_DEBUG "not a Tmty_signature";
- e
- )
- env
- decls
+ match name with
+ | None -> acc_env
+ | Some name ->
+ let complete_name = Name.concat current_module_name name in
+ let e = Odoc_env.add_module acc_env complete_name in
+ (* get the information for the module in the signature *)
+ let sig_module_type =
+ try Signature_search.search_module table name
+ with Not_found ->
+ raise (Failure (Odoc_messages.module_not_found current_module_name name))
+ in
+ match sig_module_type with
+ (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
+ Types.Mty_signature s ->
+ Odoc_env.add_signature e complete_name ~rel: name s
+ | _ ->
+ print_DEBUG "not a Tmty_signature";
+ e
+ )
+ env
+ decls
in
let rec f ?(first=false) acc_maybe_more last_pos name_mtype_list =
match name_mtype_list with
[] ->
(acc_maybe_more, [])
- | {Parsetree.pmd_name=name; pmd_type=modtype} :: q ->
- let complete_name = Name.concat current_module_name name.txt in
+ | {Parsetree.pmd_name={txt = None}; pmd_type=modtype} :: q ->
+ let loc = modtype.Parsetree.pmty_loc in
+ let loc_start = Loc.start loc in
+ let loc_end = Loc.end_ loc in
+ let _, ele_comments =
+ if first then (None, [])
+ else get_comments_in_module last_pos loc_start
+ in
+ let pos_limit2 =
+ match q with
+ [] -> pos_limit
+ | _ :: _ -> Loc.start loc
+ in
+ let (maybe_more, _) =
+ My_ir.just_after_special
+ !file_name
+ (get_string_of_file loc_end pos_limit2)
+ in
+
+ let (maybe_more2, eles) = f
+ maybe_more
+ (loc_end + maybe_more)
+ q
+ in
+ (maybe_more2, ele_comments @ eles)
+
+ | {Parsetree.pmd_name={txt = Some name}; pmd_type=modtype} :: q ->
+ let complete_name = Name.concat current_module_name name in
let loc = modtype.Parsetree.pmty_loc in
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc in
in
(* get the information for the module in the signature *)
let sig_module_type =
- try Signature_search.search_module table name.txt
+ try Signature_search.search_module table name
with Not_found ->
- raise (Failure (Odoc_messages.module_not_found current_module_name name.txt))
+ raise (Failure (Odoc_messages.module_not_found current_module_name name))
in
(* associate the comments to each constructor and build the [Type.t_type] *)
let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in
raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
)
- | Parsetree.Pmty_functor (_, pmodule_type2, module_type2) ->
+ | Parsetree.Pmty_functor (param2, module_type2) ->
(
- let loc = match pmodule_type2 with None -> Location.none
- | Some pmty -> pmty.Parsetree.pmty_loc in
+ let loc = match param2 with Parsetree.Unit -> Location.none
+ | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc in
let mp_type_code = get_string_of_file loc_start loc_end in
print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
match sig_module_type with
- Types.Mty_functor (ident, param_module_type, body_module_type) ->
- let mp_kind =
- match pmodule_type2, param_module_type with
- Some pmty, Some mty ->
+ Types.Mty_functor (param, body_module_type) ->
+ let mp_name, mp_kind =
+ match param2, param with
+ Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
+ Name.from_ident ident,
analyse_module_type_kind env current_module_name pmty mty
- | _ -> Module_type_struct []
+ | _ -> "*", Module_type_struct []
in
let param =
{
- mp_name = Name.from_ident ident ;
+ mp_name = mp_name;
mp_type =
- Misc.may_map (Odoc_env.subst_module_type env)
- param_module_type;
+ (match param with
+ | Types.Unit -> None
+ | Types.Named (_, mty) ->
+ Some (Odoc_env.subst_module_type env mty));
mp_type_code = mp_type_code ;
mp_kind = mp_kind ;
}
(* if we're here something's wrong *)
raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
)
- | Parsetree.Pmty_functor (_, pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
+ | Parsetree.Pmty_functor (param2,module_type2) (* of string * module_type * module_type *) ->
(
match sig_module_type with
- Types.Mty_functor (ident, param_module_type, body_module_type) ->
- let loc = match pmodule_type2 with None -> Location.none
- | Some pmty -> pmty.Parsetree.pmty_loc in
+ Types.Mty_functor (param, body_module_type) ->
+ let loc = match param2 with Parsetree.Unit -> Location.none
+ | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc in
let mp_type_code = get_string_of_file loc_start loc_end in
print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
- let mp_kind =
- match pmodule_type2, param_module_type with
- Some pmty, Some mty ->
+ let mp_name, mp_kind =
+ match param2, param with
+ Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
+ Name.from_ident ident,
analyse_module_type_kind env current_module_name pmty mty
- | _ -> Module_type_struct []
+ | _ -> "*", Module_type_struct []
in
let param =
{
- mp_name = Name.from_ident ident ;
- mp_type = Misc.may_map
- (Odoc_env.subst_module_type env) param_module_type ;
+ mp_name;
+ mp_type =
+ (match param with
+ | Types.Unit -> None
+ | Types.Named(_, mty) -> Some (Odoc_env.subst_module_type env mty));
mp_type_code = mp_type_code ;
mp_kind = mp_kind ;
}
end
module Analyser :
- functor (My_ir : Info_retriever) ->
+ Info_retriever ->
sig
(** This variable is used to load a file as a string and retrieve characters from it.*)
val file : string ref
run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.h \
../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
- ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/mlvalues.h \
- ../runtime/caml/major_gc.h ../runtime/caml/freelist.h \
- ../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \
+ ../runtime/caml/domain_state.h ../runtime/caml/mlvalues.h \
+ ../runtime/caml/domain_state.tbl ../runtime/caml/memory.h \
+ ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
+ ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
+ ../runtime/caml/address_class.h ../runtime/caml/domain.h \
../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h
ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \
../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
../runtime/caml/mlvalues.h ../runtime/caml/config.h \
- ../runtime/caml/misc.h ../runtime/caml/memory.h ../runtime/caml/gc.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/major_gc.h \
+ ../runtime/caml/misc.h ../runtime/caml/domain_state.h \
+ ../runtime/caml/mlvalues.h ../runtime/caml/domain_state.tbl \
+ ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
- ../runtime/caml/address_class.h ../runtime/caml/alloc.h \
- ../runtime/caml/signals.h ../runtime/caml/osdeps.h \
- ../runtime/caml/memory.h
+ ../runtime/caml/address_class.h ../runtime/caml/domain.h \
+ ../runtime/caml/alloc.h ../runtime/caml/signals.h \
+ ../runtime/caml/osdeps.h ../runtime/caml/memory.h
actions.cmo : \
+ variables.cmi \
result.cmi \
environments.cmi \
actions.cmi
actions.cmx : \
+ variables.cmx \
result.cmx \
environments.cmx \
actions.cmi
actions.cmi : \
+ variables.cmi \
result.cmi \
environments.cmi
actions_helpers.cmo : \
variables.cmi \
+ strace.cmi \
run_command.cmi \
result.cmi \
ocamltest_stdlib.cmi \
+ modifier_parser.cmi \
filecompare.cmi \
environments.cmi \
builtin_variables.cmi \
actions_helpers.cmi
actions_helpers.cmx : \
variables.cmx \
+ strace.cmx \
run_command.cmx \
result.cmx \
ocamltest_stdlib.cmx \
+ modifier_parser.cmx \
filecompare.cmx \
environments.cmx \
builtin_variables.cmx \
variables.cmi
environments.cmo : \
variables.cmi \
- tsl_lexer.cmi \
ocamltest_stdlib.cmi \
environments.cmi
environments.cmx : \
variables.cmx \
- tsl_lexer.cmx \
ocamltest_stdlib.cmx \
environments.cmi
environments.cmi : \
actions.cmx \
main.cmi
main.cmi :
+modifier_parser.cmo : \
+ variables.cmi \
+ tsl_lexer.cmi \
+ ocamltest_stdlib.cmi \
+ environments.cmi \
+ modifier_parser.cmi
+modifier_parser.cmx : \
+ variables.cmx \
+ tsl_lexer.cmx \
+ ocamltest_stdlib.cmx \
+ environments.cmx \
+ modifier_parser.cmi
+modifier_parser.cmi : \
+ environments.cmi
ocaml_actions.cmo : \
result.cmi \
ocamltest_stdlib.cmi \
ocamltest_stdlib.cmx \
run_command.cmi
run_command.cmi :
+strace.cmo : \
+ variables.cmi \
+ strace.cmi
+strace.cmx : \
+ variables.cmx \
+ strace.cmi
+strace.cmi : \
+ variables.cmi
tests.cmo : \
result.cmi \
actions.cmi \
include $(ROOTDIR)/Makefile.config
include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
ifeq "$(filter str,$(OTHERLIBRARIES))" ""
str := false
run_command.mli run_command.ml \
filecompare.mli filecompare.ml \
variables.mli variables.ml \
+ environments.mli environments.ml \
result.mli result.ml \
actions.mli actions.ml \
tests.mli tests.ml \
+ strace.mli strace.ml \
tsl_ast.mli tsl_ast.ml \
tsl_parser.mly \
tsl_lexer.mli tsl_lexer.mll \
- environments.mli environments.ml \
+ modifier_parser.mli modifier_parser.ml \
tsl_semantics.mli tsl_semantics.ml \
builtin_variables.mli builtin_variables.ml \
actions_helpers.mli actions_helpers.ml \
-strict-sequence -safe-string -strict-formats \
-w +a-4-9-41-42-44-45-48 -warn-error A
-ocamlc := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/ocamlc $(flags)
+ocamlc := $(BEST_OCAMLC) $(flags)
-ocamlopt := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/ocamlopt $(flags)
+ocamlopt := $(BEST_OCAMLOPT) $(flags)
-ocamldep := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/boot/ocamlc -depend
+ocamldep := $(BEST_OCAMLDEP)
depflags := -slash
depincludes :=
-ocamllex := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/lex/ocamllex
+ocamllex := $(BEST_OCAMLLEX)
ocamlyacc := $(ROOTDIR)/yacc/ocamlyacc
$(ocamlyacc) $<
%.ml: %.mll
- $(ocamllex) -q $<
-
-%.$(O): %.c
- $(CC) $(OC_CFLAGS) $(OC_CPPFLAGS) -c $<
+ $(ocamllex) $(OCAMLLEX_FLAGS) $<
ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config
sed \
-e 's|@@CFLAGS@@|$(OC_CFLAGS)|' \
-e 's|@@CCOMPTYPE@@|$(CCOMPTYPE)|' \
-e 's|@@WINDOWS_UNICODE@@|$(WINDOWS_UNICODE)|' \
+ -e 's|@@FUNCTION_SECTIONS@@|$(FUNCTION_SECTIONS)|' \
$< > $@
.PHONY: clean
mutable hook : code option
}
-let action_name a = a.name
+let name a = a.name
+
+let action_name = Variables.make ("action_name", "Name of the current action")
let make n c = { name = n; body = c; hook = None }
let code = match action.hook with
| None -> action.body
| Some code -> code in
+ let env = Environments.add action_name action.name env in
code log env
module ActionSet = Set.Make
type nonrec t = t
let compare = compare
end)
+
+let _ = Variables.register_variable action_name
type t
-val action_name : t -> string
+val name : t -> string
+
+val action_name : Variables.t
val update : t -> code -> t
?(stderr_variable=Builtin_variables.stderr)
?(append=false)
?(timeout=0)
- log env cmd
+ log env original_cmd
=
let log_redirection std filename =
if filename<>"" then
begin
Printf.fprintf log " Redirecting %s to %s \n%!" std filename
end in
+ let cmd =
+ if (Environments.lookup_as_bool Strace.strace env) = Some true then
+ begin
+ let action_name = Environments.safe_lookup Actions.action_name env in
+ let test_build_directory = test_build_directory env in
+ let strace_logfile_name = Strace.get_logfile_name action_name in
+ let strace_logfile =
+ Filename.make_path [test_build_directory; strace_logfile_name]
+ in
+ let strace_flags = Environments.safe_lookup Strace.strace_flags env in
+ let strace_cmd =
+ ["strace"; "-f"; "-o"; strace_logfile; strace_flags]
+ in
+ strace_cmd @ original_cmd
+ end else original_cmd
+ in
let lst = List.concat (List.map String.words cmd) in
let quoted_lst =
if Sys.os_type="Win32"
log scriptenv in
let final_value =
if Result.is_pass result then begin
- match Environments.modifiers_of_file response_file with
+ match Modifier_parser.modifiers_of_file response_file with
| modifiers ->
let modified_env = Environments.apply_modifiers newenv modifiers in
(result, modified_env)
} in let exit_status = run settings in
let final_value = match exit_status with
| 0 ->
- begin match Environments.modifiers_of_file response_file with
+ begin match Modifier_parser.modifiers_of_file response_file with
| modifiers ->
let modified_env = Environments.apply_modifiers hookenv modifiers in
(Result.pass, modified_env)
Filecompare.reference_filename = reference_filename;
Filecompare.output_filename = output_filename
} in
+ let ignore_header_conf = {
+ Filecompare.lines = skip_lines;
+ Filecompare.bytes = skip_bytes;
+ } in
let tool =
- Filecompare.(make_cmp_tool ~ignore:{lines=skip_lines;bytes=skip_bytes}) in
+ Filecompare.make_cmp_tool ~ignore:ignore_header_conf in
match Filecompare.check_file ~tool files with
| Filecompare.Same -> (Result.pass, env)
| Filecompare.Different ->
then begin
Printf.fprintf log "Promoting %s output %s to reference %s\n%!"
kind_of_output output_filename reference_filename;
- Sys.copy_file output_filename reference_filename;
+ Filecompare.promote files ignore_header_conf;
end;
(Result.fail_with_reason reason, env)
| Filecompare.Unexpected_output ->
"64-bit architecture"
"non-64-bit architecture")
+let arch_arm = make
+ "arch_arm"
+ (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "arm")
+ "Target is ARM architecture"
+ "Target is not ARM architecture")
+
+let arch_arm64 = make
+ "arch_arm64"
+ (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "arm64")
+ "Target is ARM64 architecture"
+ "Target is not ARM64 architecture")
+
+ let arch_amd64 = make
+ "arch_amd64"
+ (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "amd64")
+ "Target is AMD64 architecture"
+ "Target is not AMD64 architecture")
+
+ let arch_i386 = make
+ "arch_i386"
+ (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "i386")
+ "Target is i386 architecture"
+ "Target is not i386 architecture")
+
let arch_power = make
"arch_power"
(Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "power")
"Target is POWER architecture"
"Target is not POWER architecture")
+let function_sections = make
+ "function_sections"
+ (Actions_helpers.pass_or_skip (Ocamltest_config.function_sections)
+ "Target supports function sections"
+ "Target does not support function sections")
+
let has_symlink = make
"has_symlink"
(Actions_helpers.pass_or_skip (Sys.has_symlink () )
run;
script;
check_program_output;
+ arch_arm;
+ arch_arm64;
+ arch_amd64;
+ arch_i386;
arch_power;
+ function_sections;
]
(rule
(targets ocamltest_config.ml)
- (deps ../Makefile.config ../Makefile.common Makefile
+ (deps ../Makefile.config ../Makefile.common ../Makefile.best_binaries Makefile
./ocamltest_config.ml.in ./getocamloptdefaultflags)
(action (run make %{targets})))
| Remove variable -> remove variable environment
and apply_modifiers environment modifiers =
List.fold_left apply_modifier environment modifiers
-
-let modifier_of_string str =
- let lexbuf = Lexing.from_string str in
- let variable_name, result = Tsl_lexer.modifier lexbuf in
- let variable =
- match Variables.find_variable variable_name with
- | None -> raise (Variables.No_such_variable variable_name)
- | Some variable -> variable
- in
- match result with
- | `Remove -> Remove variable
- | `Add value -> Add (variable, value)
- | `Append value -> Append (variable, value)
-
-let modifiers_of_file filename =
- let ic = open_in filename in
- let rec modifiers_of_lines acc = match input_line_opt ic with
- | None -> acc
- | Some line ->
- modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in
- let modifiers = modifiers_of_lines [] in
- close_in ic;
- List.rev modifiers
exception Modifiers_name_not_found of string
val register_modifiers : string -> modifiers -> unit
-
-val modifier_of_string : string -> modifier
-
-val modifiers_of_file : string -> modifiers
in
Sys.force_remove temporary_file;
result
+
+let promote files ignore_conf =
+ match files.filetype, ignore_conf with
+ | Text, {lines = skip_lines; _} ->
+ let reference = open_out files.reference_filename in
+ let output = open_in files.output_filename in
+ for _ = 1 to skip_lines do
+ try ignore (input_line output) with End_of_file -> ()
+ done;
+ Sys.copy_chan output reference;
+ close_out reference;
+ close_in output
+ | Binary, {bytes = skip_bytes; _} ->
+ let reference = open_out_bin files.reference_filename in
+ let output = open_in_bin files.output_filename in
+ seek_in output skip_bytes;
+ Sys.copy_chan output reference;
+ close_out reference;
+ close_in output
val cmp_result_of_exitcode : string -> int -> result
val diff : files -> (string, string) Stdlib.result
+
+val promote : files -> ignore -> unit
let used_tests = tests_in_trees test_trees in
let used_actions = actions_in_tests used_tests in
let action_names =
- let f act names = String.Set.add (Actions.action_name act) names in
+ let f act names = String.Set.add (Actions.name act) names in
Actions.ActionSet.fold f used_actions String.Set.empty in
let test_dirname = Filename.dirname test_filename in
let test_basename = Filename.basename test_filename in
(* Restore current working directory *)
Sys.chdir cwd
-let main () =
- if !Options.files_to_test = [] then begin
- print_usage();
- exit 1
+let is_test s =
+ match tsl_block_of_file s with
+ | _ -> true
+ | exception _ -> false
+
+let ignored s =
+ s = "" || s.[0] = '_' || s.[0] = '.'
+
+let find_test_dirs dir =
+ let res = ref [] in
+ let rec loop dir =
+ let contains_tests = ref false in
+ Array.iter (fun s ->
+ if ignored s then ()
+ else begin
+ let s = dir ^ "/" ^ s in
+ if Sys.is_directory s then loop s
+ else if not !contains_tests && is_test s then contains_tests := true
+ end
+ ) (Sys.readdir dir);
+ if !contains_tests then res := dir :: !res
+ in
+ loop dir;
+ List.rev !res
+
+let list_tests dir =
+ let res = ref [] in
+ if Sys.is_directory dir then begin
+ Array.iter (fun s ->
+ if ignored s then ()
+ else begin
+ let s' = dir ^ "/" ^ s in
+ if Sys.is_directory s' || not (is_test s') then ()
+ else res := s :: !res
+ end
+ ) (Sys.readdir dir)
end;
- init_tests_to_skip();
- List.iter test_file !Options.files_to_test
+ List.rev !res
+
+let () =
+ init_tests_to_skip()
+
+let main () =
+ let failed = ref false in
+ let work_done = ref false in
+ let list_tests dir =
+ match list_tests dir with
+ | [] -> failed := true
+ | res -> List.iter print_endline res
+ in
+ let find_test_dirs dir = List.iter print_endline (find_test_dirs dir) in
+ let doit f x = work_done := true; f x in
+ List.iter (doit find_test_dirs) !Options.find_test_dirs;
+ List.iter (doit list_tests) !Options.list_tests;
+ List.iter (doit test_file) !Options.files_to_test;
+ if not !work_done then print_usage();
+ if !failed || not !work_done then exit 1
let _ = main()
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Parsing of modifier (response) files created by hooks and scripts *)
+
+open Ocamltest_stdlib
+
+let modifier_of_string str =
+ let lexbuf = Lexing.from_string str in
+ let variable_name, result = Tsl_lexer.modifier lexbuf in
+ let variable =
+ match Variables.find_variable variable_name with
+ | None -> raise (Variables.No_such_variable variable_name)
+ | Some variable -> variable
+ in
+ match result with
+ | `Remove -> Environments.Remove variable
+ | `Add value -> Environments.Add (variable, value)
+ | `Append value -> Environments.Append (variable, value)
+
+let modifiers_of_file filename =
+ let ic = open_in filename in
+ let rec modifiers_of_lines acc = match input_line_opt ic with
+ | None -> acc
+ | Some line ->
+ modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in
+ let modifiers = modifiers_of_lines [] in
+ close_in ic;
+ List.rev modifiers
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Parsing of modifier (response) files created by hooks and scripts *)
+
+val modifier_of_string : string -> Environments.modifier
+
+val modifiers_of_file : string -> Environments.modifiers
let run_codegen log env =
let ocamlsrcdir = Ocaml_directories.srcdir () in
let testfile = Actions_helpers.testfile env in
+ let testfile_basename = Filename.chop_extension testfile in
let what = Printf.sprintf "Running codegen on %s" testfile in
Printf.fprintf log "%s\n%!" what;
let test_build_directory =
compiler_output
env
in
+ let output_file = Filename.make_filename testfile_basename "output" in
+ let output = Filename.make_path [test_build_directory; output_file] in
+ let env = Environments.add Builtin_variables.output output env in
let commandline =
[
Ocaml_commands.ocamlrun_codegen ocamlsrcdir;
+ flags env;
"-S " ^ testfile
] in
let expected_exit_status = 0 in
log env commandline in
if exit_status=expected_exit_status
then begin
- let testfile_basename = Filename.chop_extension testfile in
let finalise =
if Ocamltest_config.ccomptype="msvc"
then finalise_codegen_msvc
let nativecc_libs = "@@NATIVECCLIBS@@"
let windows_unicode = @@WINDOWS_UNICODE@@ != 0
+
+let function_sections = @@FUNCTION_SECTIONS@@
val nativecc_libs : string
val windows_unicode : bool
+
+val function_sections : bool
+(** Whether the compiler was configured to generate
+ each function in a separate section *)
val run_system_command : string -> unit
val make_directory : string -> unit
val string_of_file : string -> string
+ val copy_chan : in_channel -> out_channel -> unit
val copy_file : string -> string -> unit
val force_remove : string -> unit
val has_symlink : unit -> bool
List.iter print_object objects;
exit 0
-let string_of_action = Actions.action_name
+let string_of_action = Actions.name
let string_of_test test =
if test.Tests.test_run_by_default
let promote = ref false
+let find_test_dirs = ref []
+
+let list_tests = ref []
+
+let add_to_list r x =
+ r := !r @ [x]
+
let commandline_options =
[
- ("-e", Arg.Set log_to_stderr, "Log to stderr instead of a file.");
+ ("-e", Arg.Set log_to_stderr, " Log to stderr instead of a file.");
("-promote", Arg.Set promote,
- "Overwrite reference files with the test output (experimental, unstable)");
- ("-show-actions", Arg.Unit show_actions, "Show available actions.");
- ("-show-tests", Arg.Unit show_tests, "Show available tests.");
- ("-show-variables", Arg.Unit show_variables, "Show available variables.");
+ " Overwrite reference files with the test output (experimental, unstable)");
+ ("-show-actions", Arg.Unit show_actions, " Show available actions.");
+ ("-show-tests", Arg.Unit show_tests, " Show available tests.");
+ ("-show-variables", Arg.Unit show_variables, " Show available variables.");
+ ("-find-test-dirs", Arg.String (add_to_list find_test_dirs),
+ " Find directories that contain tests (recursive).");
+ ("-list-tests", Arg.String (add_to_list list_tests),
+ " List tests in given directory.");
]
let files_to_test = ref []
-let add_testfile name = files_to_test := !files_to_test @ [name]
-
let usage = "Usage: " ^ Sys.argv.(0) ^ " options files to test"
let _ =
- Arg.parse commandline_options add_testfile usage
+ Arg.parse (Arg.align commandline_options) (add_to_list files_to_test) usage
val promote : bool ref
val usage : string
+
+val find_test_dirs : string list ref
+
+val list_tests : string list ref
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Implementation of the strace feature *)
+
+let strace = Variables.make ("strace", "Whether to use strace")
+let strace_flags =
+ Variables.make ("strace_flags", "Which flags to pass to strace")
+
+let (counters : (string, int) Hashtbl.t) = Hashtbl.create 10
+
+let get_logfile_name base =
+ let n = try Hashtbl.find counters base with Not_found -> 1 in
+ let filename = Printf.sprintf "strace-%s_%d.log" base n in
+ Hashtbl.replace counters base (n+1);
+ filename
+
+let _ =
+ Variables.register_variable strace;
+ Variables.register_variable strace_flags
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Interface to the strace feature *)
+
+val strace : Variables.t
+
+val strace_flags : Variables.t
+
+val get_logfile_name : string -> string
let test_of_action action =
{
- test_name = Actions.action_name action;
+ test_name = Actions.name action;
test_run_by_default = false;
test_actions = [action]
}
| action::remaining_actions ->
begin
Printf.fprintf log "Running action %d/%d (%s)\n%!"
- action_number total (Actions.action_name action);
+ action_number total (Actions.name action);
let (result, env') = Actions.run log env action in
Printf.fprintf log "Action %d/%d (%s) %s\n%!"
- action_number total (Actions.action_name action)
+ action_number total (Actions.name action)
(Result.string_of_result result);
if Result.is_pass result
then run_actions_aux (action_number+1) env' remaining_actions
let comment_start_pos = ref []
let lexer_error message =
- Printf.eprintf "%s\n%!" message;
- exit 2
-
+ failwith (Printf.sprintf "Tsl lexer: %s" message)
}
let newline = ('\013'* '\010')
file line column (Lexing.lexeme lexbuf) in
lexer_error message
}
+ | eof
+ { lexer_error "unexpected eof" }
(* Backslashes are ignored in strings except at the end of lines where they
cause the newline to be ignored. After an escaped newline, any blank
characters at the start of the line are ignored and optionally one blank
ROOTDIR=../..
include $(ROOTDIR)/Makefile.config
include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \
- -I $(ROOTDIR)/stdlib
+CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
+CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
+
OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS)
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
else
OPTCOMPFLAGS=
endif
+ifeq "$(FUNCTION_SECTIONS)" "true"
+OPTCOMPFLAGS += -function-sections
+endif
MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
-# Variables to be defined by individual libraries:
-#LIBNAME=
-#CLIBNAME=
-#CMIFILES=
-#CAMLOBJS=
-#COBJS=
-#EXTRACFLAGS=
-#EXTRACAMLFLAGS=
-#LINKOPTS=
-#LDOPTS=
-#HEADERS=
-
+# Variables that must be defined by individual libraries:
+# LIBNAME
+# CAMLOBJS
+
+# Variables that can be defined by individual libraries,
+# but have sensible default values:
+COBJS ?=
+EXTRACFLAGS ?=
+EXTRACAMLFLAGS ?=
+LINKOPTS ?=
+LDOPTS ?=
+HEADERS ?=
CMIFILES ?= $(CAMLOBJS:.cmo=.cmi)
CAMLOBJS_NAT ?= $(CAMLOBJS:.cmo=.cmx)
CLIBNAME ?= $(LIBNAME)
include $(ROOTDIR)/Makefile.config
include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC=$(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLOPT=$(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
# COMPFLAGS should be in sync with the toplevel Makefile's COMPFLAGS.
COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \
typing/ident.ml \
typing/path.ml \
typing/primitive.ml \
+ typing/type_immediacy.ml \
typing/types.ml \
typing/btype.ml \
typing/subst.ml \
# provide .ml files for .mli-only modules---without this, such modules do
# not seem to be located by the type checker inside bytecode packs.
-$(LOCAL_SRC)/Makefile: $(LOCAL_SRC)/Makefile.copy-sources
+$(LOCAL_SRC)/Makefile: $(LOCAL_SRC)/Makefile.copy-sources Makefile
cp -f $< $@
for ml in $(COMPILERLIBS_SOURCES); do \
echo "$(LOCAL_SRC)/$$(basename $$ml): $(ROOTDIR)/$$ml" \
$(LOCAL_SRC)/*.ml $(LOCAL_SRC)/*.mli $(LOCAL_SRC)/Makefile \
$(LOCAL_SRC)/.depend byte/dynlink.mli native/dynlink.mli
+.PHONY: beforedepend
+beforedepend: dynlink_platform_intf.mli
+
.PHONY: depend
ifeq "$(TOOLCHAIN)" "msvc"
depend:
native/dynlink_compilerlibs.ml \
byte/dynlink_compilerlibs.mli \
byte/dynlink.mli \
- native/dynlink.mli \
- dynlink_platform_intf.mli
+ native/dynlink.mli
-depend:
+depend: beforedepend
touch $(DEPEND_DUMMY_FILES)
$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
- -I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend
+ -I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend
$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
- -I native -native *.ml native/dynlink.ml >> .depend
+ -I native -native *.ml native/dynlink.ml >> .depend
rm -f $(DEPEND_DUMMY_FILES)
endif
(** Construction of dynlink functionality given the platform-specific code. *)
-module Make (P : Dynlink_platform_intf.S) : sig
+module Make (_ : Dynlink_platform_intf.S) : sig
val is_native : bool
val loadfile : string -> unit
val loadfile_private : string -> unit
spacetime_offline.$(O): spacetime_offline.c ../../runtime/caml/alloc.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/config.h \
../../runtime/caml/fail.h ../../runtime/caml/gc.h \
../../runtime/caml/intext.h ../../runtime/caml/io.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/misc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/roots.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h ../../runtime/caml/stack.h \
- ../../runtime/caml/sys.h ../../runtime/caml/spacetime.h \
- ../../runtime/caml/stack.h ../../runtime/caml/s.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/roots.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/stack.h ../../runtime/caml/sys.h \
+ ../../runtime/caml/spacetime.h ../../runtime/caml/stack.h \
+ ../../runtime/caml/s.h
raw_spacetime_lib.cmo : \
raw_spacetime_lib.cmi
raw_spacetime_lib.cmx : \
strstubs.$(O): strstubs.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/fail.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h
str.cmo : \
str.cmi
str.cmx : \
st_stubs_b.$(O): st_stubs.c ../../runtime/caml/alloc.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/backtrace.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \
../../runtime/caml/exec.h ../../runtime/caml/callback.h \
- ../../runtime/caml/custom.h ../../runtime/caml/fail.h \
- ../../runtime/caml/io.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/custom.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/io.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \
../../runtime/caml/roots.h ../../runtime/caml/memory.h \
../../runtime/caml/signals.h ../../runtime/caml/stacks.h \
- ../../runtime/caml/sys.h threads.h
+ ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \
+ ../../runtime/caml/roots.h threads.h
st_stubs_n.$(O): st_stubs.c ../../runtime/caml/alloc.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/backtrace.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \
../../runtime/caml/exec.h ../../runtime/caml/callback.h \
- ../../runtime/caml/custom.h ../../runtime/caml/fail.h \
- ../../runtime/caml/io.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/custom.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/io.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \
../../runtime/caml/roots.h ../../runtime/caml/memory.h \
../../runtime/caml/signals.h ../../runtime/caml/stack.h \
- ../../runtime/caml/sys.h threads.h
+ ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \
+ ../../runtime/caml/roots.h threads.h
condition.cmo : \
mutex.cmi \
condition.cmi
include $(ROOTDIR)/Makefile.config
include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+
+NATIVE_CPPFLAGS = \
+ -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM)
CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
LIBS = -nostdlib -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/$(UNIXLIB)
-CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc $(LIBS)
-CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt $(LIBS)
+CAMLC=$(BEST_OCAMLC) $(LIBS)
+CAMLOPT=$(BEST_OCAMLOPT) $(LIBS)
+
MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string
ifeq "$(FLAMBDA)" "true"
# st_stubs_n.$(O) from the same source file st_stubs.c (it is compiled
# twice, each time with different options).
+st_stubs_n.$(O): OC_CPPFLAGS += $(NATIVE_CPPFLAGS)
+
st_stubs_b.$(O): st_stubs.c $(HEADER)
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) -I$(ROOTDIR)/runtime \
- $(SHAREDLIB_CFLAGS) $(OUTPUTOBJ)$@ $<
+ $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
st_stubs_n.$(O): st_stubs.c $(HEADER)
- $(CC) $(OC_CFLAGS) $(OC_CPPFLAGS) \
- -I$(ROOTDIR)/runtime $(SHAREDLIB_CFLAGS) -DNATIVE_CODE \
- -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) \
- $(OUTPUTOBJ)$@ -c $<
+ $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
partialclean:
rm -f *.cm*
$(error Dependencies cannot be regenerated using the MSVC ports)
else
depend:
- $(CC) -MM $(OC_CPPFLAGS) -I$(ROOTDIR)/runtime st_stubs.c \
+ $(CC) -MM $(OC_CPPFLAGS) st_stubs.c \
| sed -e 's/st_stubs\.o/st_stubs_b.$$(O)/' \
-e 's/ st_\(posix\|win32\)\.h//g' > .depend
- $(CC) -MM $(OC_CPPFLAGS) -I$(ROOTDIR)/runtime \
- -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) \
+ $(CC) -MM $(OC_CPPFLAGS) $(NATIVE_CPPFLAGS) \
st_stubs.c | sed -e 's/st_stubs\.o/st_stubs_n.$$(O)/' \
-e 's/ st_\(posix\|win32\)\.h//g' >> .depend
$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
pthread_cond_signal(&m->is_free);
}
+CAMLno_tsan /* This can be called for reading [waiters] without locking. */
static INLINE int st_masterlock_waiters(st_masterlock * m)
{
return m->waiters;
#include "caml/backtrace.h"
#include "caml/callback.h"
#include "caml/custom.h"
+#include "caml/domain.h"
#include "caml/fail.h"
#include "caml/io.h"
#include "caml/memory.h"
#include "caml/stacks.h"
#endif
#include "caml/sys.h"
+#include "caml/memprof.h"
#include "threads.h"
#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
/* The infos on threads (allocated via caml_stat_alloc()) */
struct caml_thread_struct {
- value descr; /* The heap-allocated descriptor (root) */
+ value descr; /* The heap-allocated descriptor (root) */
struct caml_thread_struct * next; /* Double linking of running threads */
struct caml_thread_struct * prev;
#ifdef NATIVE_CODE
- char * top_of_stack; /* Top of stack for this thread (approx.) */
- char * bottom_of_stack; /* Saved value of caml_bottom_of_stack */
- uintnat last_retaddr; /* Saved value of caml_last_return_address */
- value * gc_regs; /* Saved value of caml_gc_regs */
- char * exception_pointer; /* Saved value of caml_exception_pointer */
+ char * top_of_stack; /* Top of stack for this thread (approx.) */
+ char * bottom_of_stack; /* Saved value of Caml_state->bottom_of_stack */
+ uintnat last_retaddr; /* Saved value of Caml_state->last_return_address */
+ value * gc_regs; /* Saved value of Caml_state->gc_regs */
+ char * exception_pointer; /* Saved value of Caml_state->exception_pointer */
struct caml__roots_block * local_roots; /* Saved value of local_roots */
struct longjmp_buffer * exit_buf; /* For thread exit */
#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
value* spacetime_finaliser_trie_root;
#endif
#else
- value * stack_low; /* The execution stack for this thread */
+ value * stack_low; /* The execution stack for this thread */
value * stack_high;
value * stack_threshold;
- value * sp; /* Saved value of caml_extern_sp for this thread */
- value * trapsp; /* Saved value of caml_trapsp for this thread */
- struct caml__roots_block * local_roots; /* Saved value of caml_local_roots */
- struct longjmp_buffer * external_raise; /* Saved caml_external_raise */
+ value * sp; /* Saved value of Caml_state->extern_sp for this thread */
+ value * trapsp; /* Saved value of Caml_state->trapsp for this thread */
+ /* Saved value of Caml_state->local_roots */
+ struct caml__roots_block * local_roots;
+ struct longjmp_buffer * external_raise; /* Saved Caml_state->external_raise */
#endif
- int backtrace_pos; /* Saved caml_backtrace_pos */
- backtrace_slot * backtrace_buffer; /* Saved caml_backtrace_buffer */
- value backtrace_last_exn; /* Saved caml_backtrace_last_exn (root) */
+ int backtrace_pos; /* Saved Caml_state->backtrace_pos */
+ backtrace_slot * backtrace_buffer; /* Saved Caml_state->backtrace_buffer */
+ value backtrace_last_exn; /* Saved Caml_state->backtrace_last_exn (root) */
+ int memprof_suspended; /* Saved caml_memprof_suspended */
};
typedef struct caml_thread_struct * caml_thread_t;
static inline void caml_thread_save_runtime_state(void)
{
#ifdef NATIVE_CODE
- curr_thread->top_of_stack = caml_top_of_stack;
- curr_thread->bottom_of_stack = caml_bottom_of_stack;
- curr_thread->last_retaddr = caml_last_return_address;
- curr_thread->gc_regs = caml_gc_regs;
- curr_thread->exception_pointer = caml_exception_pointer;
- curr_thread->local_roots = caml_local_roots;
+ curr_thread->top_of_stack = Caml_state->top_of_stack;
+ curr_thread->bottom_of_stack = Caml_state->bottom_of_stack;
+ curr_thread->last_retaddr = Caml_state->last_return_address;
+ curr_thread->gc_regs = Caml_state->gc_regs;
+ curr_thread->exception_pointer = Caml_state->exception_pointer;
#ifdef WITH_SPACETIME
curr_thread->spacetime_trie_node_ptr
= caml_spacetime_trie_node_ptr;
= caml_spacetime_finaliser_trie_root;
#endif
#else
- curr_thread->stack_low = caml_stack_low;
- curr_thread->stack_high = caml_stack_high;
- curr_thread->stack_threshold = caml_stack_threshold;
- curr_thread->sp = caml_extern_sp;
- curr_thread->trapsp = caml_trapsp;
- curr_thread->local_roots = caml_local_roots;
- curr_thread->external_raise = caml_external_raise;
+ curr_thread->stack_low = Caml_state->stack_low;
+ curr_thread->stack_high = Caml_state->stack_high;
+ curr_thread->stack_threshold = Caml_state->stack_threshold;
+ curr_thread->sp = Caml_state->extern_sp;
+ curr_thread->trapsp = Caml_state->trapsp;
+ curr_thread->external_raise = Caml_state->external_raise;
#endif
- curr_thread->backtrace_pos = caml_backtrace_pos;
- curr_thread->backtrace_buffer = caml_backtrace_buffer;
- curr_thread->backtrace_last_exn = caml_backtrace_last_exn;
+ curr_thread->local_roots = Caml_state->local_roots;
+ curr_thread->backtrace_pos = Caml_state->backtrace_pos;
+ curr_thread->backtrace_buffer = Caml_state->backtrace_buffer;
+ curr_thread->backtrace_last_exn = Caml_state->backtrace_last_exn;
+ curr_thread->memprof_suspended = caml_memprof_suspended;
}
static inline void caml_thread_restore_runtime_state(void)
{
#ifdef NATIVE_CODE
- caml_top_of_stack = curr_thread->top_of_stack;
- caml_bottom_of_stack= curr_thread->bottom_of_stack;
- caml_last_return_address = curr_thread->last_retaddr;
- caml_gc_regs = curr_thread->gc_regs;
- caml_exception_pointer = curr_thread->exception_pointer;
- caml_local_roots = curr_thread->local_roots;
+ Caml_state->top_of_stack = curr_thread->top_of_stack;
+ Caml_state->bottom_of_stack= curr_thread->bottom_of_stack;
+ Caml_state->last_return_address = curr_thread->last_retaddr;
+ Caml_state->gc_regs = curr_thread->gc_regs;
+ Caml_state->exception_pointer = curr_thread->exception_pointer;
#ifdef WITH_SPACETIME
caml_spacetime_trie_node_ptr
= curr_thread->spacetime_trie_node_ptr;
= curr_thread->spacetime_finaliser_trie_root;
#endif
#else
- caml_stack_low = curr_thread->stack_low;
- caml_stack_high = curr_thread->stack_high;
- caml_stack_threshold = curr_thread->stack_threshold;
- caml_extern_sp = curr_thread->sp;
- caml_trapsp = curr_thread->trapsp;
- caml_local_roots = curr_thread->local_roots;
- caml_external_raise = curr_thread->external_raise;
+ Caml_state->stack_low = curr_thread->stack_low;
+ Caml_state->stack_high = curr_thread->stack_high;
+ Caml_state->stack_threshold = curr_thread->stack_threshold;
+ Caml_state->extern_sp = curr_thread->sp;
+ Caml_state->trapsp = curr_thread->trapsp;
+ Caml_state->external_raise = curr_thread->external_raise;
#endif
- caml_backtrace_pos = curr_thread->backtrace_pos;
- caml_backtrace_buffer = curr_thread->backtrace_buffer;
- caml_backtrace_last_exn = curr_thread->backtrace_last_exn;
+ Caml_state->local_roots = curr_thread->local_roots;
+ Caml_state->backtrace_pos = curr_thread->backtrace_pos;
+ Caml_state->backtrace_buffer = curr_thread->backtrace_buffer;
+ Caml_state->backtrace_last_exn = curr_thread->backtrace_last_exn;
+ caml_memprof_suspended = curr_thread->memprof_suspended;
}
/* Hooks for caml_enter_blocking_section and caml_leave_blocking_section */
th->backtrace_pos = 0;
th->backtrace_buffer = NULL;
th->backtrace_last_exn = Val_unit;
+ th->memprof_suspended = 0;
return th;
}
st_tls_set(thread_descriptor_key, (void *) th);
/* Acquire the global mutex */
caml_leave_blocking_section();
+ caml_setup_stack_overflow_detection();
#ifdef NATIVE_CODE
/* Setup termination handler (for caml_thread_exit) */
if (sigsetjmp(termination_buf.buf, 0) == 0) {
fprintf(stderr, "Thread %d killed on uncaught exception %s\n",
Int_val(Ident(curr_thread->descr)), msg);
caml_stat_free(msg);
- if (caml_backtrace_active) caml_print_exception_backtrace();
+ if (Caml_state->backtrace_active) caml_print_exception_backtrace();
fflush(stderr);
return Val_unit;
}
our blocking section doesn't contain anything interesting, don't bother
with saving errno.)
*/
- caml_process_pending_signals();
+ caml_raise_if_exception(caml_process_pending_signals_exn());
caml_thread_save_runtime_state();
st_thread_yield(&caml_master_lock);
curr_thread = st_tls_get(thread_descriptor_key);
caml_thread_restore_runtime_state();
- caml_process_pending_signals();
+ caml_raise_if_exception(caml_process_pending_signals_exn());
return Val_unit;
}
accept.o: accept.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
access.o: access.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
addrofstr.o: addrofstr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
alarm.o: alarm.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
bind.o: bind.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h unixsupport.h socketaddr.h \
../../runtime/caml/misc.h
channels.o: channels.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h ../../runtime/caml/io.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/io.h \
+ ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
chdir.o: chdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
chmod.o: chmod.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
chown.o: chown.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
chroot.o: chroot.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
close.o: close.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
closedir.o: closedir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
connect.o: connect.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h \
socketaddr.h ../../runtime/caml/misc.h
cst2constr.o: cst2constr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h cst2constr.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ cst2constr.h
cstringv.o: cstringv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
dup.o: dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
dup2.o: dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
envir.o: envir.c ../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h
errmsg.o: errmsg.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h
execv.o: execv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
execve.o: execve.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
execvp.o: execvp.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
exit.o: exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
fchmod.o: fchmod.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
fchown.o: fchown.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
fcntl.o: fcntl.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h unixsupport.h
fork.o: fork.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/debugger.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/debugger.h \
unixsupport.h
fsync.o: fsync.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
ftruncate.o: ftruncate.c ../../runtime/caml/fail.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h
getaddrinfo.o: getaddrinfo.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h \
- cst2constr.h socketaddr.h
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/signals.h unixsupport.h cst2constr.h socketaddr.h
getcwd.o: getcwd.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- unixsupport.h
+ ../../runtime/caml/domain.h unixsupport.h
getegid.o: getegid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
geteuid.o: geteuid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
getgid.o: getgid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
getgr.o: getgr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
getgroups.o: getgroups.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
gethost.o: gethost.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
gethostname.o: gethostname.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
getlogin.o: getlogin.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
getnameinfo.o: getnameinfo.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
getpeername.o: getpeername.c ../../runtime/caml/fail.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
unixsupport.h socketaddr.h ../../runtime/caml/misc.h
getpid.o: getpid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
getppid.o: getppid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
getproto.o: getproto.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
getpw.o: getpw.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/fail.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h unixsupport.h
getserv.o: getserv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
getsockname.o: getsockname.c ../../runtime/caml/fail.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
unixsupport.h socketaddr.h ../../runtime/caml/misc.h
gettimeofday.o: gettimeofday.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
getuid.o: getuid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
gmtime.o: gmtime.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
initgroups.o: initgroups.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
isatty.o: isatty.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
itimer.o: itimer.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
kill.o: kill.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h unixsupport.h \
- ../../runtime/caml/signals.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ unixsupport.h ../../runtime/caml/signals.h
link.o: link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
listen.o: listen.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h unixsupport.h
lockf.o: lockf.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
lseek.o: lseek.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h
mkdir.o: mkdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
mkfifo.o: mkfifo.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
mmap.o: mmap.c ../../runtime/caml/bigarray.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
../../runtime/caml/mlvalues.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/fail.h ../../runtime/caml/io.h \
../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h \
../../runtime/caml/sys.h unixsupport.h
mmap_ba.o: mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h
nice.o: nice.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
open.o: open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h
opendir.o: opendir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/signals.h unixsupport.h
pipe.o: pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
putenv.o: putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
read.o: read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
readdir.o: readdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
../../runtime/caml/alloc.h ../../runtime/caml/signals.h unixsupport.h
readlink.o: readlink.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h unixsupport.h
rename.o: rename.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
rewinddir.o: rewinddir.c ../../runtime/caml/fail.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
unixsupport.h
rmdir.o: rmdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
select.o: select.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
sendrecv.o: sendrecv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
setgid.o: setgid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
setgroups.o: setgroups.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
setsid.o: setsid.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h unixsupport.h
setuid.o: setuid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
shutdown.o: shutdown.c ../../runtime/caml/fail.h \
../../runtime/caml/misc.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
unixsupport.h
signals.o: signals.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
sleep.o: sleep.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
socket.o: socket.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h unixsupport.h
socketaddr.o: socketaddr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
socketpair.o: socketpair.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
sockopt.o: sockopt.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/fail.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
stat.o: stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/io.h unixsupport.h \
- cst2constr.h nanosecond_stat.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/io.h unixsupport.h cst2constr.h nanosecond_stat.h
strofaddr.o: strofaddr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h socketaddr.h \
../../runtime/caml/misc.h
symlink.o: symlink.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
termios.o: termios.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
time.o: time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
times.o: times.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h
truncate.o: truncate.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/fail.h \
- ../../runtime/caml/signals.h ../../runtime/caml/io.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/io.h unixsupport.h
umask.o: umask.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
unixsupport.o: unixsupport.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/callback.h ../../runtime/caml/memory.h \
- ../../runtime/caml/fail.h unixsupport.h cst2constr.h
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ cst2constr.h
unlink.o: unlink.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
utimes.o: utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
wait.o: wait.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h
write.o: write.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
unix.cmo : \
unix.cmi
unix.cmx : \
else
aliases = Atom(0);
entry_h_length = entry->h_length;
-#ifdef h_addr
addr_list =
caml_alloc_array(alloc_one_addr, (const char**)entry->h_addr_list);
-#else
- adr = alloc_one_addr(entry->h_addr);
- addr_list = caml_alloc_small(1, 0);
- Field(addr_list, 0) = adr;
-#endif
res = caml_alloc_small(4, 0);
Field(res, 0) = name;
Field(res, 1) = aliases;
(** Execute the given command, wait until it terminates, and return
its termination status. The string is interpreted by the shell
[/bin/sh] (or the command interpreter [cmd.exe] on Windows) and
- therefore can contain redirections, quotes, variables, etc. The
- result [WEXITED 127] indicates that the shell couldn't be
+ therefore can contain redirections, quotes, variables, etc.
+ To properly quote whitespace and shell special characters occuring
+ in file names or command arguments, the use of
+ {!Filename.quote_command} is recommended.
+ The result [WEXITED 127] indicates that the shell couldn't be
executed. *)
val getpid : unit -> int
offset (from the beginning of the file). *)
val truncate : string -> int -> unit
-(** Truncates the named file to the given size.
-
- On Windows: not implemented. *)
+(** Truncates the named file to the given size. *)
val ftruncate : file_descr -> int -> unit
(** Truncates the file corresponding to the given descriptor
- to the given size.
-
- On Windows: not implemented. *)
+ to the given size. *)
(** {1 File status} *)
The standard output of the command is redirected to a pipe,
which can be read via the returned input channel.
The command is interpreted by the shell [/bin/sh]
- (or [cmd.exe] on Windows), cf. [system]. *)
+ (or [cmd.exe] on Windows), cf. {!Unix.system}.
+ The {!Filename.quote_command} function can be used to
+ quote the command and its arguments as appropriate for the shell being
+ used. If the command does not need to be run through the shell,
+ {!Unix.open_process_args_in} can be used as a more robust and
+ more efficient alternative to {!Unix.open_process_in}. *)
val open_process_out : string -> out_channel
(** Same as {!Unix.open_process_in}, but redirect the standard input of
is sent to the standard input of the command.
Warning: writes on output channels are buffered, hence be careful
to call {!Stdlib.flush} at the right times to ensure
- correct synchronization. *)
+ correct synchronization.
+ If the command does not need to be run through the shell,
+ {!Unix.open_process_args_out} can be used instead of
+ {!Unix.open_process_out}. *)
val open_process : string -> in_channel * out_channel
(** Same as {!Unix.open_process_out}, but redirects both the standard input
and standard output of the command to pipes connected to the two
returned channels. The input channel is connected to the output
- of the command, and the output channel to the input of the command. *)
+ of the command, and the output channel to the input of the command.
+ If the command does not need to be run through the shell,
+ {!Unix.open_process_args} can be used instead of
+ {!Unix.open_process}. *)
val open_process_full :
string -> string array -> in_channel * out_channel * in_channel
(** Similar to {!Unix.open_process}, but the second argument specifies
the environment passed to the command. The result is a triple
of channels connected respectively to the standard output, standard input,
- and standard error of the command. *)
+ and standard error of the command.
+ If the command does not need to be run through the shell,
+ {!Unix.open_process_args_full} can be used instead of
+ {!Unix.open_process_full}. *)
val open_process_args_in : string -> string array -> in_channel
(** High-level pipe and process management. The first argument specifies the
accept.$(O): accept.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
bind.$(O): bind.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
channels.$(O): channels.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/io.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h
close.$(O): close.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h \
../../runtime/caml/io.h
close_on.$(O): close_on.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
connect.$(O): connect.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h socketaddr.h ../../runtime/caml/misc.h
createprocess.$(O): createprocess.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h unixsupport.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h
dup.$(O): dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
dup2.$(O): dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
errmsg.$(O): errmsg.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h
envir.$(O): envir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h
getpeername.$(O): getpeername.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
getpid.$(O): getpid.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
getsockname.$(O): getsockname.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
gettimeofday.$(O): gettimeofday.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
isatty.$(O): isatty.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- unixsupport.h
+ ../../runtime/caml/domain.h unixsupport.h
link.$(O): link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
listen.$(O): listen.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
lockf.$(O): lockf.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h unixsupport.h ../../runtime/caml/signals.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ ../../runtime/caml/signals.h
lseek.$(O): lseek.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
nonblock.$(O): nonblock.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
mkdir.$(O): mkdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h
mmap.$(O): mmap.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/bigarray.h ../../runtime/caml/fail.h \
../../runtime/caml/io.h ../../runtime/caml/mlvalues.h \
../../runtime/caml/signals.h ../../runtime/caml/sys.h \
../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h
open.$(O): open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/memory.h \
- unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/memory.h unixsupport.h
pipe.$(O): pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/alloc.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h unixsupport.h
read.$(O): read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
readlink.$(O): readlink.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
rename.$(O): rename.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h
select.$(O): select.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/fail.h \
- ../../runtime/caml/signals.h winworker.h unixsupport.h windbug.h \
- winlist.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h winworker.h \
+ unixsupport.h windbug.h winlist.h
sendrecv.$(O): sendrecv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
shutdown.$(O): shutdown.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
sleep.$(O): sleep.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
socket.$(O): socket.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
sockopt.$(O): sockopt.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/fail.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
startup.$(O): startup.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h winworker.h \
- unixsupport.h windbug.h
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl winworker.h unixsupport.h windbug.h
stat.$(O): stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h ../unix/cst2constr.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h \
+ ../unix/cst2constr.h
symlink.$(O): symlink.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
system.$(O): system.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
times.$(O): times.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+truncate.$(O): truncate.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/io.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
unixsupport.$(O): unixsupport.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/callback.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/callback.h \
../../runtime/caml/alloc.h ../../runtime/caml/memory.h \
- ../../runtime/caml/fail.h ../../runtime/caml/custom.h unixsupport.h \
- ../unix/cst2constr.h
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/custom.h unixsupport.h ../unix/cst2constr.h
windir.$(O): windir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
winwait.$(O): winwait.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h
write.$(O): write.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
winlist.$(O): winlist.c winlist.h
winworker.$(O): winworker.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h winworker.h \
- unixsupport.h winlist.h windbug.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h winworker.h unixsupport.h winlist.h \
+ windbug.h
windbug.$(O): windbug.c windbug.h
utimes.$(O): utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
access.$(O): access.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
addrofstr.$(O): addrofstr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
chdir.$(O): chdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
chmod.$(O): chmod.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
cst2constr.$(O): cst2constr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
../unix/cst2constr.h
cstringv.$(O): cstringv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
execv.$(O): execv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
execve.$(O): execve.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
execvp.$(O): execvp.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
exit.$(O): exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
getaddrinfo.$(O): getaddrinfo.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h \
- ../unix/cst2constr.h socketaddr.h
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/signals.h unixsupport.h ../unix/cst2constr.h \
+ socketaddr.h
getcwd.$(O): getcwd.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- unixsupport.h
+ ../../runtime/caml/domain.h unixsupport.h
gethost.$(O): gethost.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
gethostname.$(O): gethostname.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h
getnameinfo.$(O): getnameinfo.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
getproto.$(O): getproto.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
getserv.$(O): getserv.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
gmtime.$(O): gmtime.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
mmap_ba.$(O): mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h
putenv.$(O): putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
../../runtime/caml/memory.h ../../runtime/caml/gc.h \
../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
rmdir.$(O): rmdir.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
socketaddr.$(O): socketaddr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/memory.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
strofaddr.$(O): strofaddr.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
../../runtime/caml/fail.h unixsupport.h socketaddr.h \
../../runtime/caml/misc.h
time.$(O): time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
unlink.$(O): unlink.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
fsync.$(O): fsync.c ../../runtime/caml/mlvalues.h \
../../runtime/caml/config.h ../../runtime/caml/m.h \
../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
unix.cmo : \
unix.cmi
unix.cmx : \
mkdir.c mmap.c open.c pipe.c read.c readlink.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
- symlink.c system.c times.c unixsupport.c windir.c winwait.c write.c \
- winlist.c winworker.c windbug.c utimes.c
+ symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
+ write.c winlist.c winworker.c windbug.c utimes.c
# Files from the ../unix directory
UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
err = GetLastError(); goto ret3;
}
/* If we do not have a console window, then we must create one
- before running the process (keep it hidden for apparence).
+ before running the process (keep it hidden for appearance).
If we are starting a GUI application, the newly created
console should not matter. */
if (win_has_console())
win_wide_char_to_multi_byte(
point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR),
cbLen,
- String_val(result),
+ (char *)String_val(result),
len);
CloseHandle(h);
}
static value fdset_to_fdlist(value fdlist, fd_set *fdset)
{
- value res = Val_int(0);
- Begin_roots2(fdlist, res)
- for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
- value s = Field(fdlist, 0);
- if (FD_ISSET(Socket_val(s), fdset)) {
- value newres = caml_alloc_small(2, 0);
- Field(newres, 0) = s;
- Field(newres, 1) = res;
- res = newres;
- }
+ CAMLparam1(fdlist);
+ CAMLlocal2(res, s);
+ res = Val_int(0);
+ for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
+ s = Field(fdlist, 0);
+ if (FD_ISSET(Socket_val(s), fdset)) {
+ value newres = caml_alloc_small(2, 0);
+ Field(newres, 0) = s;
+ Field(newres, 1) = res;
+ res = newres;
}
- End_roots();
- return res;
+ }
+ CAMLreturn(res);
}
CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
{
iterResult = &(iterSelectData->aResults[i]);
l = caml_alloc_small(2, 0);
- Store_field(l, 0, find_handle(iterResult, readfds, writefds,
- exceptfds));
+ Field(l, 0) = find_handle(iterResult, readfds, writefds,
+ exceptfds);
switch (iterResult->EMode)
{
case SELECT_MODE_READ:
- Store_field(l, 1, read_list);
+ Field(l, 1) = read_list;
read_list = l;
break;
case SELECT_MODE_WRITE:
- Store_field(l, 1, write_list);
+ Field(l, 1) = write_list;
write_list = l;
break;
case SELECT_MODE_EXCEPT:
- Store_field(l, 1, except_list);
+ Field(l, 1) = except_list;
except_list = l;
break;
case SELECT_MODE_NONE:
DEBUG_PRINT("Build final result");
res = caml_alloc_small(3, 0);
- Store_field(res, 0, read_list);
- Store_field(res, 1, write_list);
- Store_field(res, 2, except_list);
+ Field(res, 0) = read_list;
+ Field(res, 1) = write_list;
+ Field(res, 2) = except_list;
DEBUG_PRINT("out select");
return 1;
}
-static int do_stat(int do_lstat, int use_64, char* opath, HANDLE fstat, __int64* st_ino, struct _stat64* res)
+static int do_stat(int do_lstat, int use_64, const char* opath, HANDLE fstat, __int64* st_ino, struct _stat64* res)
{
wchar_t* wpath;
int ret;
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Florent Monnier */
+/* Nicolas Ojeda Bar, LexiFi */
+/* */
+/* Copyright 2019 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <sys/types.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include <caml/io.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include <windows.h>
+
+static int win_truncate_handle(HANDLE fh, __int64 len)
+{
+ LARGE_INTEGER fp;
+ fp.QuadPart = len;
+ if (SetFilePointerEx(fh, fp, NULL, FILE_BEGIN) == 0 ||
+ SetEndOfFile(fh) == 0) {
+ return -1;
+ }
+ return 0;
+}
+
+static int win_ftruncate(HANDLE fh, __int64 len)
+{
+ HANDLE dupfh, currproc;
+ int ret;
+ currproc = GetCurrentProcess();
+ /* Duplicate the handle, so we are free to modify its file position. */
+ if (DuplicateHandle(currproc, fh, currproc, &dupfh, 0, FALSE,
+ DUPLICATE_SAME_ACCESS) == 0) {
+ return -1;
+ }
+ ret = win_truncate_handle(dupfh, len);
+ CloseHandle(dupfh);
+ return ret;
+}
+
+static int win_truncate(WCHAR * path, __int64 len)
+{
+ HANDLE fh;
+ int ret;
+ fh = CreateFile(path, GENERIC_WRITE, 0, NULL,
+ OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+ if (fh == INVALID_HANDLE_VALUE) {
+ return -1;
+ }
+ ret = win_truncate_handle(fh, len);
+ CloseHandle(fh);
+ return ret;
+}
+
+CAMLprim value unix_truncate(value path, value len)
+{
+ CAMLparam2(path, len);
+ WCHAR * p;
+ int ret;
+ caml_unix_check_path(path, "truncate");
+ p = caml_stat_strdup_to_utf16(String_val(path));
+ caml_enter_blocking_section();
+ ret = win_truncate(p, Long_val(len));
+ caml_leave_blocking_section();
+ caml_stat_free(p);
+ if (ret == -1)
+ uerror("truncate", path);
+ CAMLreturn(Val_unit);
+}
+
+CAMLprim value unix_truncate_64(value path, value vlen)
+{
+ CAMLparam2(path, vlen);
+ WCHAR * p;
+ int ret;
+ __int64 len = Int64_val(vlen);
+ caml_unix_check_path(path, "truncate");
+ p = caml_stat_strdup_to_utf16(String_val(path));
+ caml_enter_blocking_section();
+ ret = win_truncate(p, len);
+ caml_leave_blocking_section();
+ caml_stat_free(p);
+ if (ret == -1)
+ uerror("truncate", path);
+ CAMLreturn(Val_unit);
+}
+
+CAMLprim value unix_ftruncate(value fd, value len)
+{
+ int ret;
+ HANDLE h = Handle_val(fd);
+ caml_enter_blocking_section();
+ ret = win_ftruncate(h, Long_val(len));
+ caml_leave_blocking_section();
+ if (ret == -1)
+ uerror("ftruncate", Nothing);
+ return Val_unit;
+}
+
+CAMLprim value unix_ftruncate_64(value fd, value vlen)
+{
+ int ret;
+ HANDLE h = Handle_val(fd);
+ __int64 len = Int64_val(vlen);
+ caml_enter_blocking_section();
+ ret = win_ftruncate(h, len);
+ caml_leave_blocking_section();
+ if (ret == -1)
+ uerror("ftruncate", Nothing);
+ return Val_unit;
+}
external lseek : file_descr -> int -> seek_command -> int = "unix_lseek"
-let truncate _name _len = invalid_arg "Unix.truncate not implemented"
-let ftruncate _fd _len = invalid_arg "Unix.ftruncate not implemented"
+external truncate : string -> int -> unit = "unix_truncate"
+external ftruncate : file_descr -> int -> unit = "unix_ftruncate"
(* File statistics *)
struct
external lseek : file_descr -> int64 -> seek_command -> int64
= "unix_lseek_64"
- let truncate _name _len =
- invalid_arg "Unix.LargeFile.truncate not implemented"
- let ftruncate _name _len =
- invalid_arg "Unix.LargeFile.ftruncate not implemented"
+ external truncate : string -> int64 -> unit = "unix_truncate_64"
+ external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64"
type stats =
{ st_dev : int;
st_ino : int;
type lid = Longident.t with_loc
type str = string with_loc
+type str_opt = string option with_loc
type attrs = attribute list
let default_loc = ref Location.none
let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)
let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a)
let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)
- let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c))
+ let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b))
let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))
let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a)
let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a)
let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)
let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x)
- let functor_ ?loc ?attrs arg arg_ty body =
- mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body))
+ let functor_ ?loc ?attrs arg body =
+ mk ?loc ?attrs (Pmod_functor (arg, body))
let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))
let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
type lid = Longident.t with_loc
type str = string with_loc
+type str_opt = string option with_loc
type attrs = attribute list
(** {1 Default locations} *)
val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern
val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
- val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern
+ val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern
val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern
val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list
-> expression
- val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression
- -> expression
+ val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr
+ -> expression -> expression
val letexception:
?loc:loc -> ?attrs:attrs -> extension_constructor -> expression
-> expression
val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type
val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
val functor_: ?loc:loc -> ?attrs:attrs ->
- str -> module_type option -> module_type -> module_type
+ functor_parameter -> module_type -> module_type
val with_: ?loc:loc -> ?attrs:attrs -> module_type ->
with_constraint list -> module_type
val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
val functor_: ?loc:loc -> ?attrs:attrs ->
- str -> module_type option -> module_expr -> module_expr
+ functor_parameter -> module_expr -> module_expr
val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr ->
module_expr
val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type ->
module Md:
sig
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
- str -> module_type -> module_declaration
+ str_opt -> module_type -> module_declaration
end
(** Module substitutions *)
module Mb:
sig
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
- str -> module_expr -> module_binding
+ str_opt -> module_expr -> module_binding
end
(** Opens *)
List.iter (sub.class_type_field sub) pcsig_fields
end
+let iter_functor_param sub = function
+ | Unit -> ()
+ | Named (name, mty) ->
+ iter_loc sub name;
+ sub.module_type sub mty
+
module MT = struct
(* Type expressions for the module language *)
| Pmty_ident s -> iter_loc sub s
| Pmty_alias s -> iter_loc sub s
| Pmty_signature sg -> sub.signature sub sg
- | Pmty_functor (s, mt1, mt2) ->
- iter_loc sub s;
- iter_opt (sub.module_type sub) mt1;
+ | Pmty_functor (param, mt2) ->
+ iter_functor_param sub param;
sub.module_type sub mt2
| Pmty_with (mt, l) ->
sub.module_type sub mt;
match desc with
| Pmod_ident x -> iter_loc sub x
| Pmod_structure str -> sub.structure sub str
- | Pmod_functor (arg, arg_ty, body) ->
- iter_loc sub arg;
- iter_opt (sub.module_type sub) arg_ty;
+ | Pmod_functor (param, body) ->
+ iter_functor_param sub param;
sub.module_expr sub body
| Pmod_apply (m1, m2) ->
sub.module_expr sub m1; sub.module_expr sub m2
(List.map (sub.class_type_field sub) pcsig_fields)
end
+let map_functor_param sub = function
+ | Unit -> Unit
+ | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt)
+
module MT = struct
(* Type expressions for the module language *)
| Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
| Pmty_alias s -> alias ~loc ~attrs (map_loc sub s)
| Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
- | Pmty_functor (s, mt1, mt2) ->
- functor_ ~loc ~attrs (map_loc sub s)
- (Misc.may_map (sub.module_type sub) mt1)
- (sub.module_type sub mt2)
+ | Pmty_functor (param, mt) ->
+ functor_ ~loc ~attrs
+ (map_functor_param sub param)
+ (sub.module_type sub mt)
| Pmty_with (mt, l) ->
with_ ~loc ~attrs (sub.module_type sub mt)
(List.map (sub.with_constraint sub) l)
match desc with
| Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
| Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
- | Pmod_functor (arg, arg_ty, body) ->
- functor_ ~loc ~attrs (map_loc sub arg)
- (Misc.may_map (sub.module_type sub) arg_ty)
+ | Pmod_functor (param, body) ->
+ functor_ ~loc ~attrs
+ (map_functor_param sub param)
(sub.module_expr sub body)
| Pmod_apply (m1, m2) ->
apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
| _ -> false
)
+let immediate64 =
+ List.exists
+ (fun a -> match a.attr_name.txt with
+ | "ocaml.immediate64"|"immediate64" -> true
+ | _ -> false
+ )
+
(* The "ocaml.boxed (default)" and "ocaml.unboxed (default)"
attributes cannot be input by the user, they are added by the
compiler when applying the default setting. This is done to record
- ocaml.warn_on_literal_pattern
- ocaml.deprecated_mutable
- ocaml.immediate
+ - ocaml.immediate64
- ocaml.boxed / ocaml.unboxed
{b Warning:} this module is unstable and part of
val immediate: Parsetree.attributes -> bool
+val immediate64: Parsetree.attributes -> bool
val has_unboxed: Parsetree.attributes -> bool
val has_boxed: Parsetree.attributes -> bool
let add_constructor_decl bv pcd =
add_constructor_arguments bv pcd.pcd_args;
- Misc.may (add_type bv) pcd.pcd_res
+ Option.iter (add_type bv) pcd.pcd_res
let add_type_declaration bv td =
List.iter
match ext.pext_kind with
Pext_decl(args, rty) ->
add_constructor_arguments bv args;
- Misc.may (add_type bv) rty
+ Option.iter (add_type bv) rty
| Pext_rebind lid -> add bv lid
let add_type_extension bv te =
| Ppat_variant(_, op) -> add_opt add_pattern bv op
| Ppat_type li -> add bv li
| Ppat_lazy p -> add_pattern bv p
- | Ppat_unpack id -> pattern_bv := String.Map.add id.txt bound !pattern_bv
+ | Ppat_unpack id ->
+ Option.iter
+ (fun name -> pattern_bv := String.Map.add name bound !pattern_bv) id.txt
| Ppat_open ( m, p) -> let bv = open_module bv m.txt in add_pattern bv p
| Ppat_exception p -> add_pattern bv p
| Ppat_extension e -> handle_extension e
| Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel
| Pexp_letmodule(id, m, e) ->
let b = add_module_binding bv m in
- add_expr (String.Map.add id.txt b bv) e
+ let bv =
+ match id.txt with
+ | None -> bv
+ | Some id -> String.Map.add id b bv
+ in
+ add_expr bv e
| Pexp_letexception(_, e) -> add_expr bv e
| Pexp_assert (e) -> add_expr bv e
| Pexp_lazy (e) -> add_expr bv e
Pmty_ident l -> add bv l
| Pmty_alias l -> add_module_path bv l
| Pmty_signature s -> add_signature bv s
- | Pmty_functor(id, mty1, mty2) ->
- Misc.may (add_modtype bv) mty1;
- add_modtype (String.Map.add id.txt bound bv) mty2
+ | Pmty_functor(param, mty2) ->
+ let bv =
+ match param with
+ | Unit -> bv
+ | Named (id, mty1) ->
+ add_modtype bv mty1;
+ match id.txt with
+ | None -> bv
+ | Some name -> String.Map.add name bound bv
+ in
+ add_modtype bv mty2
| Pmty_with(mty, cstrl) ->
add_modtype bv mty;
List.iter
add_type_exception bv te; (bv, m)
| Psig_module pmd ->
let m' = add_modtype_binding bv pmd.pmd_type in
- let add = String.Map.add pmd.pmd_name.txt m' in
+ let add map =
+ match pmd.pmd_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name m' map
+ in
(add bv, add m)
| Psig_modsubst pms ->
let m' = add_module_alias bv pms.pms_manifest in
(add bv, add m)
| Psig_recmodule decls ->
let add =
- List.fold_right (fun pmd -> String.Map.add pmd.pmd_name.txt bound)
- decls
+ List.fold_right (fun pmd map ->
+ match pmd.pmd_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name bound map
+ ) decls
in
let bv' = add bv and m' = add m in
List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
match modl.pmod_desc with
Pmod_ident l -> add_module_path bv l
| Pmod_structure s -> ignore (add_structure bv s)
- | Pmod_functor(id, mty, modl) ->
- Misc.may (add_modtype bv) mty;
- add_module_expr (String.Map.add id.txt bound bv) modl
+ | Pmod_functor(param, modl) ->
+ let bv =
+ match param with
+ | Unit -> bv
+ | Named (id, mty) ->
+ add_modtype bv mty;
+ match id.txt with
+ | None -> bv
+ | Some name -> String.Map.add name bound bv
+ in
+ add_module_expr bv modl
| Pmod_apply(mod1, mod2) ->
add_module_expr bv mod1; add_module_expr bv mod2
| Pmod_constraint(modl, mty) ->
(bv, m)
| Pstr_module x ->
let b = add_module_binding bv x.pmb_expr in
- let add = String.Map.add x.pmb_name.txt b in
+ let add map =
+ match x.pmb_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name b map
+ in
(add bv, add m)
| Pstr_recmodule bindings ->
let add =
- List.fold_right (fun x -> String.Map.add x.pmb_name.txt bound) bindings
+ List.fold_right (fun x map ->
+ match x.pmb_name.txt with
+ | None -> map
+ | Some name -> String.Map.add name bound map
+ ) bindings
in
let bv' = add bv and m = add m in
List.iter
{ store_lexeme lexbuf; comment lexbuf }
| "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
{ store_lexeme lexbuf; comment lexbuf }
+ | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'"
+ { store_lexeme lexbuf; comment lexbuf }
| "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
{ store_lexeme lexbuf; comment lexbuf }
| eof
store_lexeme lexbuf;
comment lexbuf
}
+ | (lowercase | uppercase) identchar *
+ { store_lexeme lexbuf; comment lexbuf }
| _
{ store_lexeme lexbuf; comment lexbuf }
let input_name = ref "_none_"
let input_lexbuf = ref (None : lexbuf option)
+let input_phrase_buffer = ref (None : Buffer.t option)
(******************************************************************************)
(* Terminal info *)
|> infer_line_numbers
|> List.map (fun (lnum, { text; start_pos }) ->
(text,
- Misc.Stdlib.Option.value_default Int.to_string ~default:"" lnum,
+ Option.fold ~some:Int.to_string ~none:"" lnum,
start_pos))
in
Format.fprintf ppf "@[<v>";
lines_around ~start_pos ~end_pos ~seek ~read_char
end
+(* Attempt to get lines from the phrase buffer *)
+let lines_around_from_phrasebuf
+ ~(start_pos: position) ~(end_pos: position)
+ (pb: Buffer.t):
+ input_line list
+ =
+ let pos = ref 0 in
+ let seek n = pos := n in
+ let read_char () =
+ if !pos >= Buffer.length pb then None
+ else begin
+ let c = Buffer.nth pb !pos in
+ incr pos; Some c
+ end
+ in
+ lines_around ~start_pos ~end_pos ~seek ~read_char
+
(* Get lines from a file *)
let lines_around_from_file
~(start_pos: position) ~(end_pos: position)
else
[]
in
- match !input_lexbuf with
- | Some lb ->
+ match !input_lexbuf, !input_phrase_buffer, !input_name with
+ | _, Some pb, "//toplevel//" ->
+ begin match lines_around_from_phrasebuf pb ~start_pos ~end_pos with
+ | [] -> (* Could not read the input from the phrase buffer. This is likely
+ a sign that we were given a buggy location. *)
+ []
+ | lines ->
+ lines
+ end
+ | Some lb, _, _ ->
begin match lines_around_from_lexbuf lb ~start_pos ~end_pos with
| [] -> (* The input is likely not in the lexbuf anymore *)
from_file ()
| lines ->
lines
end
- | None ->
+ | None, _, _ ->
from_file ()
(******************************************************************************)
val input_name: string ref
val input_lexbuf: Lexing.lexbuf option ref
+(* This is used for reporting errors coming from the toplevel.
+
+ When running a toplevel session (i.e. when [!input_name] is "//toplevel//"),
+ [!input_phrase_buffer] should be [Some buf] where [buf] contains the last
+ toplevel phrase. *)
+val input_phrase_buffer: Buffer.t option ref
+
(** {1 Toplevel-specific functions} *)
let not_expecting loc nonterm =
raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
+let dotop ~left ~right ~assign ~ext ~multi =
+ let assign = if assign then "<-" else "" in
+ let mid = if multi then ";.." else "" in
+ String.concat "" ["."; ext; left; mid; right; assign]
+let paren = "(",")"
+let brace = "{", "}"
+let bracket = "[", "]"
+let lident x = Lident x
+let ldot x y = Ldot(x,y)
let dotop_fun ~loc dotop =
(* We could use ghexp here, but sticking to mkexp for parser.mly
compatibility. TODO improve parser.mly *)
let string_set_fun ~loc =
ghexp ~loc (Pexp_ident(array_function ~loc "String" "set"))
+let multi_indices ~loc = function
+ | [a] -> false, a
+ | l -> true, mkexp ~loc (Pexp_array l)
+
let index_get ~loc get_fun array index =
let args = [Nolabel, array; Nolabel, index] in
mkexp ~loc (Pexp_apply(get_fun, args))
let array_get ~loc = index_get ~loc (array_get_fun ~loc)
let string_get ~loc = index_get ~loc (string_get_fun ~loc)
-let dotop_get ~loc dotop = index_get ~loc (dotop_fun ~loc dotop)
+let dotop_get ~loc path (left,right) ext array index =
+ let multi, index = multi_indices ~loc index in
+ index_get ~loc
+ (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false))
+ array index
let array_set ~loc = index_set ~loc (array_set_fun ~loc)
let string_set ~loc = index_set ~loc (string_set_fun ~loc)
-let dotop_set ~loc dotop = index_set ~loc (dotop_fun ~loc dotop)
+let dotop_set ~loc path (left,right) ext array index value=
+ let multi, index = multi_indices ~loc index in
+ index_set ~loc
+ (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true))
+ array index value
+
let bigarray_function ~loc str name =
ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name))
functor_arg:
(* An anonymous and untyped argument. *)
- x = mkrhs(LPAREN RPAREN {"*"})
- { x, None }
+ LPAREN RPAREN
+ { Unit }
| (* An argument accompanied with an explicit type. *)
- LPAREN x = mkrhs(functor_arg_name) COLON mty = module_type RPAREN
- { x, Some mty }
+ LPAREN x = mkrhs(module_name) COLON mty = module_type RPAREN
+ { Named (x, mty) }
;
-functor_arg_name:
+module_name:
(* A named argument. *)
x = UIDENT
- { x }
+ { Some x }
| (* An anonymous argument. *)
UNDERSCORE
- { "_" }
+ { None }
;
(* -------------------------------------------------------------------------- *)
{ unclosed "struct" $loc($1) "end" $loc($4) }
| FUNCTOR attrs = attributes args = functor_args MINUSGREATER me = module_expr
{ wrap_mod_attrs ~loc:$sloc attrs (
- List.fold_left (fun acc (x, mty) ->
- mkmod ~loc:$sloc (Pmod_functor (x, mty, acc))
+ List.fold_left (fun acc arg ->
+ mkmod ~loc:$sloc (Pmod_functor (arg, acc))
) me args
) }
| me = paren_module_expr
%inline module_binding:
MODULE
ext = ext attrs1 = attributes
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
body = module_binding_body
attrs2 = post_item_attributes
{ let docs = symbol_docs $sloc in
let loc = make_loc $sloc in
let attrs = attrs1 @ attrs2 in
- let body = Mb.mk uid body ~attrs ~loc ~docs in
+ let body = Mb.mk name body ~attrs ~loc ~docs in
Pstr_module body, ext }
;
COLON mty = module_type EQUAL me = module_expr
{ Pmod_constraint(me, mty) }
| arg = functor_arg body = module_binding_body
- { let (x, mty) = arg in
- Pmod_functor(x, mty, body) }
+ { Pmod_functor(arg, body) }
) { $1 }
;
ext = ext
attrs1 = attributes
REC
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
body = module_binding_body
attrs2 = post_item_attributes
{
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs $sloc in
ext,
- Mb.mk uid body ~attrs ~loc ~docs
+ Mb.mk name body ~attrs ~loc ~docs
}
;
%inline and_module_binding:
AND
attrs1 = attributes
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
body = module_binding_body
attrs2 = post_item_attributes
{
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs $sloc in
let text = symbol_text $symbolstartpos in
- Mb.mk uid body ~attrs ~loc ~text ~docs
+ Mb.mk name body ~attrs ~loc ~text ~docs
}
;
MINUSGREATER mty = module_type
%prec below_WITH
{ wrap_mty_attrs ~loc:$sloc attrs (
- List.fold_left (fun acc (x, mty) ->
- mkmty ~loc:$sloc (Pmty_functor (x, mty, acc))
+ List.fold_left (fun acc arg ->
+ mkmty ~loc:$sloc (Pmty_functor (arg, acc))
) mty args
) }
| MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT
{ Pmty_ident $1 }
| module_type MINUSGREATER module_type
%prec below_WITH
- { Pmty_functor(mknoloc "_", Some $1, $3) }
+ { Pmty_functor(Named (mknoloc None, $1), $3) }
| module_type WITH separated_nonempty_llist(AND, with_constraint)
{ Pmty_with($1, $3) }
/* | LPAREN MODULE mkrhs(mod_longident) RPAREN
%inline module_declaration:
MODULE
ext = ext attrs1 = attributes
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
body = module_declaration_body
attrs2 = post_item_attributes
{
let attrs = attrs1 @ attrs2 in
let loc = make_loc $sloc in
let docs = symbol_docs $sloc in
- Md.mk uid body ~attrs ~loc ~docs, ext
+ Md.mk name body ~attrs ~loc ~docs, ext
}
;
{ mty }
| mkmty(
arg = functor_arg body = module_declaration_body
- { let (x, mty) = arg in
- Pmty_functor(x, mty, body) }
+ { Pmty_functor(arg, body) }
)
{ $1 }
;
%inline module_alias:
MODULE
ext = ext attrs1 = attributes
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
EQUAL
body = module_expr_alias
attrs2 = post_item_attributes
let attrs = attrs1 @ attrs2 in
let loc = make_loc $sloc in
let docs = symbol_docs $sloc in
- Md.mk uid body ~attrs ~loc ~docs, ext
+ Md.mk name body ~attrs ~loc ~docs, ext
}
;
%inline module_expr_alias:
ext = ext
attrs1 = attributes
REC
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
COLON
mty = module_type
attrs2 = post_item_attributes
let attrs = attrs1 @ attrs2 in
let loc = make_loc $sloc in
let docs = symbol_docs $sloc in
- ext, Md.mk uid mty ~attrs ~loc ~docs
+ ext, Md.mk name mty ~attrs ~loc ~docs
}
;
%inline and_module_declaration:
AND
attrs1 = attributes
- uid = mkrhs(UIDENT)
+ name = mkrhs(module_name)
COLON
mty = module_type
attrs2 = post_item_attributes
let docs = symbol_docs $sloc in
let loc = make_loc $sloc in
let text = symbol_text $symbolstartpos in
- Md.mk uid mty ~attrs ~loc ~text ~docs
+ Md.mk name mty ~attrs ~loc ~text ~docs
}
;
{ string_set ~loc:$sloc $1 $4 $7 }
| simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
{ bigarray_set ~loc:$sloc $1 $4 $7 }
- | simple_expr DOTOP LBRACKET expr RBRACKET LESSMINUS expr
- { dotop_set ~loc:$sloc (Lident ("." ^ $2 ^ "[]<-")) $1 $4 $7 }
- | simple_expr DOTOP LPAREN expr RPAREN LESSMINUS expr
- { dotop_set ~loc:$sloc (Lident ("." ^ $2 ^ "()<-")) $1 $4 $7 }
- | simple_expr DOTOP LBRACE expr RBRACE LESSMINUS expr
- { dotop_set ~loc:$sloc (Lident ("." ^ $2 ^ "{}<-")) $1 $4 $7 }
- | simple_expr DOT mod_longident DOTOP LBRACKET expr RBRACKET LESSMINUS expr
- { dotop_set ~loc:$sloc (Ldot($3,"." ^ $4 ^ "[]<-")) $1 $6 $9 }
- | simple_expr DOT mod_longident DOTOP LPAREN expr RPAREN LESSMINUS expr
- { dotop_set ~loc:$sloc (Ldot($3, "." ^ $4 ^ "()<-")) $1 $6 $9 }
- | simple_expr DOT mod_longident DOTOP LBRACE expr RBRACE LESSMINUS expr
- { dotop_set ~loc:$sloc (Ldot($3, "." ^ $4 ^ "{}<-")) $1 $6 $9 }
+ | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET LESSMINUS expr
+ { dotop_set ~loc:$sloc lident bracket $2 $1 $4 $7 }
+ | simple_expr DOTOP LPAREN expr_semi_list RPAREN LESSMINUS expr
+ { dotop_set ~loc:$sloc lident paren $2 $1 $4 $7 }
+ | simple_expr DOTOP LBRACE expr_semi_list RBRACE LESSMINUS expr
+ { dotop_set ~loc:$sloc lident brace $2 $1 $4 $7 }
+ | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET
+ LESSMINUS expr
+ { dotop_set ~loc:$sloc (ldot $3) bracket $4 $1 $6 $9 }
+ | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN
+ LESSMINUS expr
+ { dotop_set ~loc:$sloc (ldot $3) paren $4 $1 $6 $9 }
+ | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE
+ LESSMINUS expr
+ { dotop_set ~loc:$sloc (ldot $3) brace $4 $1 $6 $9 }
| expr attribute
{ Exp.attr $1 $2 }
| UNDERSCORE
{ not_expecting $loc($1) "wildcard \"_\"" }
;
%inline expr_attrs:
- | LET MODULE ext_attributes mkrhs(UIDENT) module_binding_body IN seq_expr
+ | LET MODULE ext_attributes mkrhs(module_name) module_binding_body IN seq_expr
{ Pexp_letmodule($4, $5, $7), $3 }
| LET EXCEPTION ext_attributes let_exception_declaration IN seq_expr
{ Pexp_letexception($4, $6), $3 }
{ string_get ~loc:$sloc $1 $4 }
| simple_expr DOT LBRACKET seq_expr error
{ unclosed "[" $loc($3) "]" $loc($5) }
- | simple_expr DOTOP LBRACKET expr RBRACKET
- { dotop_get ~loc:$sloc (Lident ("." ^ $2 ^ "[]")) $1 $4 }
- | simple_expr DOTOP LBRACKET expr error
+ | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET
+ { dotop_get ~loc:$sloc lident bracket $2 $1 $4 }
+ | simple_expr DOTOP LBRACKET expr_semi_list error
{ unclosed "[" $loc($3) "]" $loc($5) }
- | simple_expr DOTOP LPAREN expr RPAREN
- { dotop_get ~loc:$sloc (Lident ("." ^ $2 ^ "()")) $1 $4 }
- | simple_expr DOTOP LPAREN expr error
+ | simple_expr DOTOP LPAREN expr_semi_list RPAREN
+ { dotop_get ~loc:$sloc lident paren $2 $1 $4 }
+ | simple_expr DOTOP LPAREN expr_semi_list error
{ unclosed "(" $loc($3) ")" $loc($5) }
- | simple_expr DOTOP LBRACE expr RBRACE
- { dotop_get ~loc:$sloc (Lident ("." ^ $2 ^ "{}")) $1 $4 }
+ | simple_expr DOTOP LBRACE expr_semi_list RBRACE
+ { dotop_get ~loc:$sloc lident brace $2 $1 $4 }
| simple_expr DOTOP LBRACE expr error
{ unclosed "{" $loc($3) "}" $loc($5) }
- | simple_expr DOT mod_longident DOTOP LBRACKET expr RBRACKET
- { dotop_get ~loc:$sloc (Ldot($3, "." ^ $4 ^ "[]")) $1 $6 }
+ | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET
+ { dotop_get ~loc:$sloc (ldot $3) bracket $4 $1 $6 }
| simple_expr DOT
- mod_longident DOTOP LBRACKET expr error
+ mod_longident DOTOP LBRACKET expr_semi_list error
{ unclosed "[" $loc($5) "]" $loc($7) }
- | simple_expr DOT mod_longident DOTOP LPAREN expr RPAREN
- { dotop_get ~loc:$sloc (Ldot($3, "." ^ $4 ^ "()")) $1 $6 }
+ | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN
+ { dotop_get ~loc:$sloc (ldot $3) paren $4 $1 $6 }
| simple_expr DOT
- mod_longident DOTOP LPAREN expr error
+ mod_longident DOTOP LPAREN expr_semi_list error
{ unclosed "(" $loc($5) ")" $loc($7) }
- | simple_expr DOT mod_longident DOTOP LBRACE expr RBRACE
- { dotop_get ~loc:$sloc (Ldot($3, "." ^ $4 ^ "{}")) $1 $6 }
+ | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE
+ { dotop_get ~loc:$sloc (ldot $3) brace $4 $1 $6 }
| simple_expr DOT
- mod_longident DOTOP LBRACE expr error
+ mod_longident DOTOP LBRACE expr_semi_list error
{ unclosed "{" $loc($5) "}" $loc($7) }
| simple_expr DOT LBRACE expr RBRACE
{ bigarray_get ~loc:$sloc $1 $4 }
{ reloc_pat ~loc:$sloc $2 }
| simple_delimited_pattern
{ $1 }
- | LPAREN MODULE ext_attributes mkrhs(UIDENT) RPAREN
+ | LPAREN MODULE ext_attributes mkrhs(module_name) RPAREN
{ mkpat_attrs ~loc:$sloc (Ppat_unpack $4) $3 }
- | LPAREN MODULE ext_attributes mkrhs(UIDENT) COLON package_type RPAREN
+ | LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type RPAREN
{ mkpat_attrs ~loc:$sloc
(Ppat_constraint(mkpat ~loc:$sloc (Ppat_unpack $4), $6))
$3 }
{ unclosed "(" $loc($1) ")" $loc($5) }
| LPAREN pattern COLON error
{ expecting $loc($4) "type" }
- | LPAREN MODULE ext_attributes UIDENT COLON package_type
+ | LPAREN MODULE ext_attributes module_name COLON package_type
error
{ unclosed "(" $loc($1) ")" $loc($7) }
| extension
PREFIXOP { $1 }
| LETOP { $1 }
| ANDOP { $1 }
- | DOTOP LPAREN RPAREN { "."^ $1 ^"()" }
- | DOTOP LPAREN RPAREN LESSMINUS { "."^ $1 ^ "()<-" }
- | DOTOP LBRACKET RBRACKET { "."^ $1 ^"[]" }
- | DOTOP LBRACKET RBRACKET LESSMINUS { "."^ $1 ^ "[]<-" }
- | DOTOP LBRACE RBRACE { "."^ $1 ^"{}" }
- | DOTOP LBRACE RBRACE LESSMINUS { "."^ $1 ^ "{}<-" }
+ | DOTOP LPAREN index_mod RPAREN { "."^ $1 ^"(" ^ $3 ^ ")" }
+ | DOTOP LPAREN index_mod RPAREN LESSMINUS { "."^ $1 ^ "(" ^ $3 ^ ")<-" }
+ | DOTOP LBRACKET index_mod RBRACKET { "."^ $1 ^"[" ^ $3 ^ "]" }
+ | DOTOP LBRACKET index_mod RBRACKET LESSMINUS { "."^ $1 ^ "[" ^ $3 ^ "]<-" }
+ | DOTOP LBRACE index_mod RBRACE { "."^ $1 ^"{" ^ $3 ^ "}" }
+ | DOTOP LBRACE index_mod RBRACE LESSMINUS { "."^ $1 ^ "{" ^ $3 ^ "}<-" }
| HASHOP { $1 }
| BANG { "!" }
| infix_operator { $1 }
| AMPERAMPER {"&&"}
| COLONEQUAL {":="}
;
+index_mod:
+| { "" }
+| SEMI DOTDOT { ";.." }
+;
constr_ident:
UIDENT { $1 }
| LBRACKET RBRACKET { "[]" }
Suffixes are rejected by the typechecker.
*)
+type location_stack = Location.t list
+
(** {1 Extension points} *)
type attribute = {
{
ptyp_desc: core_type_desc;
ptyp_loc: Location.t;
- ptyp_loc_stack: Location.t list;
+ ptyp_loc_stack: location_stack;
ptyp_attributes: attributes; (* ... [@id1] [@id2] *)
}
{
ppat_desc: pattern_desc;
ppat_loc: Location.t;
- ppat_loc_stack: Location.t list;
+ ppat_loc_stack: location_stack;
ppat_attributes: attributes; (* ... [@id1] [@id2] *)
}
(* #tconst *)
| Ppat_lazy of pattern
(* lazy P *)
- | Ppat_unpack of string loc
- (* (module P)
+ | Ppat_unpack of string option loc
+ (* (module P) Some "P"
+ (module _) None
+
Note: (module P : S) is represented as
Ppat_constraint(Ppat_unpack, Ptyp_package)
*)
{
pexp_desc: expression_desc;
pexp_loc: Location.t;
- pexp_loc_stack: Location.t list;
+ pexp_loc_stack: location_stack;
pexp_attributes: attributes; (* ... [@id1] [@id2] *)
}
(* x <- 2 *)
| Pexp_override of (label loc * expression) list
(* {< x1 = E1; ...; Xn = En >} *)
- | Pexp_letmodule of string loc * module_expr * expression
+ | Pexp_letmodule of string option loc * module_expr * expression
(* let module M = ME in E *)
| Pexp_letexception of extension_constructor * expression
(* let exception C in E *)
(* S *)
| Pmty_signature of signature
(* sig ... end *)
- | Pmty_functor of string loc * module_type option * module_type
+ | Pmty_functor of functor_parameter * module_type
(* functor(X : MT1) -> MT2 *)
| Pmty_with of module_type * with_constraint list
(* MT with ... *)
| Pmty_alias of Longident.t loc
(* (module M) *)
+and functor_parameter =
+ | Unit
+ (* () *)
+ | Named of string option loc * module_type
+ (* (X : MT) Some X, MT
+ (_ : MT) None, MT *)
+
and signature = signature_item list
and signature_item =
and module_declaration =
{
- pmd_name: string loc;
+ pmd_name: string option loc;
pmd_type: module_type;
pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
pmd_loc: Location.t;
(* X *)
| Pmod_structure of structure
(* struct ... end *)
- | Pmod_functor of string loc * module_type option * module_expr
+ | Pmod_functor of functor_parameter * module_expr
(* functor(X : MT1) -> ME *)
| Pmod_apply of module_expr * module_expr
(* ME1(ME2) *)
and module_binding =
{
- pmb_name: string loc;
+ pmb_name: string option loc;
pmb_expr: module_expr;
pmb_attributes: attributes;
pmb_loc: Location.t;
| Ppat_var ({txt = txt;_}) -> protect_ident f txt
| Ppat_array l ->
pp f "@[<2>[|%a|]@]" (list (pattern1 ctxt) ~sep:";") l
- | Ppat_unpack (s) ->
- pp f "(module@ %s)@ " s.txt
+ | Ppat_unpack { txt = None } ->
+ pp f "(module@ _)@ "
+ | Ppat_unpack { txt = Some s } ->
+ pp f "(module@ %s)@ " s
| Ppat_type li ->
pp f "#%a" longident_loc li
| Ppat_record (l, closed) ->
| Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
pexp_attributes=[]; _}, args)
when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
- let print_indexop a path_prefix assign left right print_index indices
+ let print_indexop a path_prefix assign left sep right print_index indices
rem_args =
let print_path ppf = function
| None -> ()
| false, [] ->
pp f "@[%a%a%s%a%s@]"
(simple_expr ctxt) a print_path path_prefix
- left (list ~sep:"," print_index) indices right; true
+ left (list ~sep print_index) indices right; true
| true, [v] ->
pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
(simple_expr ctxt) a print_path path_prefix
- left (list ~sep:"," print_index) indices right
+ left (list ~sep print_index) indices right
(simple_expr ctxt) v; true
| _ -> false in
match id, List.map snd args with
let print = print_indexop a None assign in
match path, other_args with
| Lident "Array", i :: rest ->
- print ".(" ")" (expression ctxt) [i] rest
+ print ".(" "" ")" (expression ctxt) [i] rest
| Lident "String", i :: rest ->
- print ".[" "]" (expression ctxt) [i] rest
+ print ".[" "" "]" (expression ctxt) [i] rest
| Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
- print ".{" "}" (simple_expr ctxt) [i1] rest
+ print ".{" "," "}" (simple_expr ctxt) [i1] rest
| Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
- print ".{" "}" (simple_expr ctxt) [i1; i2] rest
+ print ".{" "," "}" (simple_expr ctxt) [i1; i2] rest
| Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
- print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest
+ print ".{" "," "}" (simple_expr ctxt) [i1; i2; i3] rest
| Ldot (Lident "Bigarray", "Genarray"),
{pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
- print ".{" "}" (simple_expr ctxt) indexes rest
+ print ".{" "," "}" (simple_expr ctxt) indexes rest
| _ -> false
end
| (Lident s | Ldot(_,s)) , a :: i :: rest
assignment operators end with [right_bracket ^ "<-"],
access operators end with [right_bracket] directly
*)
+ let multi_indices = String.contains s ';' in
+ let i =
+ match i.pexp_desc with
+ | Pexp_array l when multi_indices -> l
+ | _ -> [ i ] in
let assign = last_is '-' s in
let kind =
(* extract the right end bracket *)
| Ldot(m,_) -> Some m
| _ -> None in
let left = String.sub s 0 (1+String.index s left) in
- print_indexop a path_prefix assign left right
- (expression ctxt) [i] rest
+ print_indexop a path_prefix assign left ";" right
+ (if multi_indices then expression ctxt else simple_expr ctxt)
+ i rest
| _ -> false
end
| _ -> false
pp f "@[<hov2>{<%a>}@]"
(list string_x_expression ~sep:";" ) l;
| Pexp_letmodule (s, me, e) ->
- pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
+ pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]"
+ (Option.value s.txt ~default:"_")
(module_expr reset_ctxt) me (expression ctxt) e
| Pexp_letexception (cd, e) ->
pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
(attributes ctxt) x.pmty_attributes
end else
match x.pmty_desc with
- | Pmty_functor (_, None, mt2) ->
+ | Pmty_functor (Unit, mt2) ->
pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
- | Pmty_functor (s, Some mt1, mt2) ->
- if s.txt = "_" then
- pp f "@[<hov2>%a@ ->@ %a@]"
- (module_type1 ctxt) mt1 (module_type ctxt) mt2
- else
- pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
- (module_type ctxt) mt1 (module_type ctxt) mt2
+ | Pmty_functor (Named (s, mt1), mt2) ->
+ begin match s.txt with
+ | None ->
+ pp f "@[<hov2>%a@ ->@ %a@]"
+ (module_type1 ctxt) mt1 (module_type ctxt) mt2
+ | Some name ->
+ pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" name
+ (module_type ctxt) mt1 (module_type ctxt) mt2
+ end
| Pmty_with (mt, []) -> module_type ctxt f mt
| Pmty_with (mt, l) ->
let with_constraint f = function
end
| Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
pmty_attributes=[]; _};_} as pmd) ->
- pp f "@[<hov>module@ %s@ =@ %a@]%a" pmd.pmd_name.txt
+ pp f "@[<hov>module@ %s@ =@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
longident_loc alias
(item_attributes ctxt) pmd.pmd_attributes
| Psig_module pmd ->
pp f "@[<hov>module@ %s@ :@ %a@]%a"
- pmd.pmd_name.txt
+ (Option.value pmd.pmd_name.txt ~default:"_")
(module_type ctxt) pmd.pmd_type
(item_attributes ctxt) pmd.pmd_attributes
| Psig_modsubst pms ->
| [] -> () ;
| pmd :: tl ->
if not first then
- pp f "@ @[<hov2>and@ %s:@ %a@]%a" pmd.pmd_name.txt
+ pp f "@ @[<hov2>and@ %s:@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
(module_type1 ctxt) pmd.pmd_type
(item_attributes ctxt) pmd.pmd_attributes
else
- pp f "@[<hov2>module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt
+ pp f "@[<hov2>module@ rec@ %s:@ %a@]%a"
+ (Option.value pmd.pmd_name.txt ~default:"_")
(module_type1 ctxt) pmd.pmd_type
(item_attributes ctxt) pmd.pmd_attributes;
string_x_module_type_list f ~first:false tl
(module_type ctxt) mt
| Pmod_ident (li) ->
pp f "%a" longident_loc li;
- | Pmod_functor (_, None, me) ->
+ | Pmod_functor (Unit, me) ->
pp f "functor ()@;->@;%a" (module_expr ctxt) me
- | Pmod_functor (s, Some mt, me) ->
+ | Pmod_functor (Named (s, mt), me) ->
pp f "functor@ (%s@ :@ %a)@;->@;%a"
- s.txt (module_type ctxt) mt (module_expr ctxt) me
+ (Option.value s.txt ~default:"_")
+ (module_type ctxt) mt (module_expr ctxt) me
| Pmod_apply (me1, me2) ->
pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
(* Cf: #7200 *)
| Pstr_exception ed -> exception_declaration ctxt f ed
| Pstr_module x ->
let rec module_helper = function
- | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} ->
- if mt = None then pp f "()"
- else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt;
+ | {pmod_desc=Pmod_functor(arg_opt,me'); pmod_attributes = []} ->
+ begin match arg_opt with
+ | Unit -> pp f "()"
+ | Named (s, mt) ->
+ pp f "(%s:%a)" (Option.value s.txt ~default:"_")
+ (module_type ctxt) mt
+ end;
module_helper me'
| me -> me
in
pp f "@[<hov2>module %s%a@]%a"
- x.pmb_name.txt
+ (Option.value x.pmb_name.txt ~default:"_")
(fun f me ->
let me = module_helper me in
match me with
| Pstr_recmodule decls -> (* 3.07 *)
let aux f = function
| ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
- pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt
+ pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a"
+ (Option.value pmb.pmb_name.txt ~default:"_")
(module_type ctxt) typ
(module_expr ctxt) expr
(item_attributes ctxt) pmb.pmb_attributes
- | _ -> assert false
+ | pmb ->
+ pp f "@[<hov2>@ and@ %s@ =@ %a@]%a"
+ (Option.value pmb.pmb_name.txt ~default:"_")
+ (module_expr ctxt) pmb.pmb_expr
+ (item_attributes ctxt) pmb.pmb_attributes
in
begin match decls with
| ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
- pmb.pmb_name.txt
+ (Option.value pmb.pmb_name.txt ~default:"_")
(module_type ctxt) typ
(module_expr ctxt) expr
(item_attributes ctxt) pmb.pmb_attributes
(fun f l2 -> List.iter (aux f) l2) l2
+ | pmb :: l2 ->
+ pp f "@[<hv>@[<hov2>module@ rec@ %s@ =@ %a@]%a@ %a@]"
+ (Option.value pmb.pmb_name.txt ~default:"_")
+ (module_expr ctxt) pmb.pmb_expr
+ (item_attributes ctxt) pmb.pmb_attributes
+ (fun f l2 -> List.iter (aux f) l2) l2
| _ -> assert false
end
| Pstr_attribute a -> floating_attribute ctxt f a
fprintf f "\"%s\" %a" x.txt fmt_location x.loc;
;;
+let fmt_str_opt_loc f (x : string option loc) =
+ fprintf f "\"%s\" %a" (Option.value x.txt ~default:"_") fmt_location x.loc;
+;;
+
let fmt_char_option f = function
| None -> fprintf f "None"
| Some c -> fprintf f "Some %c" c
let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li;;
let string i ppf s = line i ppf "\"%s\"\n" s;;
let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s;;
+let str_opt_loc i ppf s = line i ppf "%a\n" fmt_str_opt_loc s;;
let arg_label i ppf = function
| Nolabel -> line i ppf "Nolabel\n"
| Optional s -> line i ppf "Optional \"%s\"\n" s
line i ppf "Ppat_type\n";
longident_loc i ppf li
| Ppat_unpack s ->
- line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
+ line i ppf "Ppat_unpack %a\n" fmt_str_opt_loc s;
| Ppat_exception p ->
line i ppf "Ppat_exception\n";
pattern i ppf p
line i ppf "Pexp_override\n";
list i string_x_expression ppf l;
| Pexp_letmodule (s, me, e) ->
- line i ppf "Pexp_letmodule %a\n" fmt_string_loc s;
+ line i ppf "Pexp_letmodule %a\n" fmt_str_opt_loc s;
module_expr i ppf me;
expression i ppf e;
| Pexp_letexception (cd, e) ->
| Pmty_signature (s) ->
line i ppf "Pmty_signature\n";
signature i ppf s;
- | Pmty_functor (s, mt1, mt2) ->
- line i ppf "Pmty_functor %a\n" fmt_string_loc s;
- Misc.may (module_type i ppf) mt1;
+ | Pmty_functor (Unit, mt2) ->
+ line i ppf "Pmty_functor ()\n";
+ module_type i ppf mt2;
+ | Pmty_functor (Named (s, mt1), mt2) ->
+ line i ppf "Pmty_functor %a\n" fmt_str_opt_loc s;
+ module_type i ppf mt1;
module_type i ppf mt2;
| Pmty_with (mt, l) ->
line i ppf "Pmty_with\n";
line i ppf "Psig_exception\n";
type_exception i ppf te
| Psig_module pmd ->
- line i ppf "Psig_module %a\n" fmt_string_loc pmd.pmd_name;
+ line i ppf "Psig_module %a\n" fmt_str_opt_loc pmd.pmd_name;
attributes i ppf pmd.pmd_attributes;
module_type i ppf pmd.pmd_type
| Psig_modsubst pms ->
| Pmod_structure (s) ->
line i ppf "Pmod_structure\n";
structure i ppf s;
- | Pmod_functor (s, mt, me) ->
- line i ppf "Pmod_functor %a\n" fmt_string_loc s;
- Misc.may (module_type i ppf) mt;
+ | Pmod_functor (Unit, me) ->
+ line i ppf "Pmod_functor ()\n";
+ module_expr i ppf me;
+ | Pmod_functor (Named (s, mt), me) ->
+ line i ppf "Pmod_functor %a\n" fmt_str_opt_loc s;
+ module_type i ppf mt;
module_expr i ppf me;
| Pmod_apply (me1, me2) ->
line i ppf "Pmod_apply\n";
attribute i ppf "Pstr_attribute" a
and module_declaration i ppf pmd =
- string_loc i ppf pmd.pmd_name;
+ str_opt_loc i ppf pmd.pmd_name;
attributes i ppf pmd.pmd_attributes;
module_type (i+1) ppf pmd.pmd_type;
and module_binding i ppf x =
- string_loc i ppf x.pmb_name;
+ str_opt_loc i ppf x.pmb_name;
attributes i ppf x.pmb_attributes;
module_expr (i+1) ppf x.pmb_expr
afl_b.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_b.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_b.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_b.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_b.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_b.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_b.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_b.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
caml/stacks.h caml/memory.h
clambda_checks_b.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_b.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_b.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_b.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_b.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
caml/stacks.h caml/sys.h
+domain_b.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_b.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_b.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_b.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_b.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_b.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_b.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_b.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_b.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_b.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_b.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_b.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \
+ caml/startup_aux.h
globroots_b.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_b.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_b.$(O): instrtrace.c
intern_b.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_b.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \
- caml/jumptbl.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
ints_b.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_b.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_b.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_b.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_b.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_b.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_b.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_b.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_b.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_b.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_b.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_b.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_b.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_b.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_b.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_b.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_b.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_b.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_b.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_b.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_b.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_b.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_b.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_b.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_b.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
caml/osdeps.h caml/memory.h caml/startup_aux.h
startup_byt_b.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_b.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_b.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_b.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_b.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_b.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_b.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_bd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_bd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_bd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_bd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_bd.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_bd.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_bd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_bd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
caml/stacks.h caml/memory.h
clambda_checks_bd.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_bd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_bd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_bd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_bd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
caml/stacks.h caml/sys.h
+domain_bd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_bd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_bd.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_bd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_bd.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_bd.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_bd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_bd.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_bd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_bd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_bd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_bd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \
+ caml/startup_aux.h
globroots_bd.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_bd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_bd.$(O): instrtrace.c caml/instrtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/instruct.h caml/misc.h \
- caml/mlvalues.h caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/startup_aux.h
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/instruct.h caml/misc.h caml/mlvalues.h \
+ caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/startup_aux.h
intern_bd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_bd.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h
ints_bd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_bd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_bd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_bd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_bd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_bd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_bd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_bd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_bd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_bd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_bd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_bd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_bd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_bd.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_bd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_bd.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_bd.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_bd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_bd.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_bd.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_bd.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_bd.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_bd.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_bd.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_bd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
caml/osdeps.h caml/memory.h caml/startup_aux.h
startup_byt_bd.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_bd.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_bd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_bd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_bd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_bd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_bd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_bi.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_bi.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_bi.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_bi.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_bi.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_bi.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_bi.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_bi.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
caml/stacks.h caml/memory.h
clambda_checks_bi.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_bi.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_bi.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_bi.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_bi.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
caml/stacks.h caml/sys.h
+domain_bi.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_bi.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_bi.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_bi.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_bi.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_bi.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_bi.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_bi.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_bi.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_bi.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_bi.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_bi.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \
+ caml/startup_aux.h
globroots_bi.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_bi.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_bi.$(O): instrtrace.c
intern_bi.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_bi.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \
- caml/jumptbl.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
ints_bi.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_bi.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_bi.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_bi.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_bi.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_bi.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_bi.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_bi.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_bi.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_bi.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_bi.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_bi.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_bi.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_bi.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_bi.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_bi.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_bi.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_bi.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_bi.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_bi.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_bi.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_bi.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_bi.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_bi.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_bi.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
caml/osdeps.h caml/memory.h caml/startup_aux.h
startup_byt_bi.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_bi.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_bi.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_bi.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_bi.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_bi.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_bi.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_bpic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_bpic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_bpic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_bpic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_bpic.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_bpic.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_bpic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_bpic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
caml/stacks.h caml/memory.h
clambda_checks_bpic.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_bpic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_bpic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_bpic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_bpic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
caml/stacks.h caml/sys.h
+domain_bpic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_bpic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_bpic.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_bpic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_bpic.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_bpic.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_bpic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_bpic.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_bpic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_bpic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_bpic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_bpic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \
+ caml/startup_aux.h
globroots_bpic.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_bpic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_bpic.$(O): instrtrace.c
intern_bpic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_bpic.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \
- caml/jumptbl.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
ints_bpic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_bpic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_bpic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_bpic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_bpic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_bpic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_bpic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_bpic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_bpic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_bpic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_bpic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_bpic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_bpic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_bpic.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_bpic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_bpic.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_bpic.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_bpic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_bpic.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_bpic.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_bpic.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_bpic.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_bpic.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_bpic.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_bpic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
caml/osdeps.h caml/memory.h caml/startup_aux.h
startup_byt_bpic.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_bpic.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_bpic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_bpic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_bpic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_bpic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_bpic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_n.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_n.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_n.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_n.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_n.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_n.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_n.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_n.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h
clambda_checks_n.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_n.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_n.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_n.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_n.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+domain_n.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_n.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_n.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_n.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_n.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_n.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_n.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_n.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_n.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_n.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_n.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_n.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \
+ caml/startup_aux.h
globroots_n.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_n.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_n.$(O): instrtrace.c
intern_n.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_n.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \
- caml/jumptbl.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
ints_n.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_n.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_n.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_n.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_n.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_n.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_n.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_n.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_n.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_n.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_n.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_n.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_n.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_n.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_n.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_n.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_n.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_n.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_n.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_n.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_n.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_n.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_n.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_n.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_n.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
caml/memory.h caml/startup_aux.h
startup_byt_n.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_n.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_n.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_n.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_n.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_n.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_n.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_nd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_nd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_nd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_nd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_nd.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_nd.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_nd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_nd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h
clambda_checks_nd.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_nd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_nd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_nd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_nd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+domain_nd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_nd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_nd.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_nd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_nd.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_nd.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_nd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_nd.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_nd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_nd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_nd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_nd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \
+ caml/startup_aux.h
globroots_nd.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_nd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_nd.$(O): instrtrace.c caml/instrtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/instruct.h caml/misc.h \
- caml/mlvalues.h caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/startup_aux.h
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/instruct.h caml/misc.h caml/mlvalues.h \
+ caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/startup_aux.h
intern_nd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_nd.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h
ints_nd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_nd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_nd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_nd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_nd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_nd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_nd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_nd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_nd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_nd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_nd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_nd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_nd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_nd.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_nd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_nd.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_nd.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_nd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_nd.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_nd.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_nd.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_nd.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_nd.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_nd.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_nd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
caml/memory.h caml/startup_aux.h
startup_byt_nd.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_nd.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_nd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_nd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_nd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_nd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_nd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_ni.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_ni.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_ni.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_ni.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_ni.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_ni.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_ni.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_ni.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h
clambda_checks_ni.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_ni.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_ni.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_ni.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_ni.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+domain_ni.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_ni.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_ni.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_ni.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_ni.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_ni.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_ni.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_ni.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_ni.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_ni.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_ni.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_ni.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \
+ caml/startup_aux.h
globroots_ni.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_ni.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_ni.$(O): instrtrace.c
intern_ni.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_ni.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \
- caml/jumptbl.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
ints_ni.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_ni.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_ni.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_ni.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_ni.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_ni.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_ni.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_ni.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_ni.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_ni.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_ni.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_ni.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_ni.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_ni.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_ni.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_ni.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_ni.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_ni.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_ni.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_ni.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_ni.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_ni.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_ni.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_ni.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_ni.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
caml/memory.h caml/startup_aux.h
startup_byt_ni.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_ni.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_ni.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_ni.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_ni.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_ni.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_ni.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
afl_npic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
alloc_npic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
array_npic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
backtrace_npic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \
- caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
backtrace_byt_npic.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \
- caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \
- caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
backtrace_nat_npic.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/stack.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
bigarray_npic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \
- caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
callback_npic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h
clambda_checks_npic.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
compact_npic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \
- caml/compact.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h
compare_npic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
caml/mlvalues.h
custom_npic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/signals.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
debugger_npic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+domain_npic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
dynlink_npic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \
- caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
caml/memory.h caml/prims.h caml/signals.h
dynlink_nat_npic.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
extern_npic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
fail_byt_npic.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/signals.h caml/stacks.h caml/memory.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
fail_nat_npic.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
caml/stack.h caml/roots.h caml/memory.h caml/callback.h
finalise_npic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
caml/roots.h caml/signals.h
fix_code_npic.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
floats_npic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-freelist_npic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist_npic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h
gc_ctrl_npic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \
- caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \
+ caml/startup_aux.h
globroots_npic.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
- caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
hash_npic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/hash.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
instrtrace_npic.$(O): instrtrace.c
intern_npic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \
- caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
interp_npic.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \
- caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \
- caml/jumptbl.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
ints_npic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
io_npic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
lexing_npic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
main_npic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
major_gc_npic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h caml/weak.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
md5_npic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/mlvalues.h caml/io.h caml/reverse.h
memory_npic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \
- caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h
+memprof_npic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h
meta_npic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
- caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
minor_gc_npic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h
misc_npic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \
- caml/memory.h caml/version.h
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
obj_npic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/prims.h caml/spacetime.h caml/io.h caml/stack.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
parsing_npic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/alloc.h
prims_npic.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/prims.h
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/prims.h
printexc_npic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \
- caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
roots_byt_npic.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h
roots_nat_npic.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h
signals_npic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
signals_byt_npic.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
signals_nat_npic.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
spacetime_byt_npic.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
spacetime_nat_npic.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
caml/stack.h
spacetime_snapshot_npic.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \
- caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \
- caml/spacetime.h caml/stack.h
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
stacks_npic.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
startup_aux_npic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
caml/memory.h caml/startup_aux.h
startup_byt_npic.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \
- caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \
caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \
caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \
caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \
- caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \
+ caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \
caml/startup_aux.h caml/version.h
startup_nat_npic.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \
- caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \
caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \
- caml/stack.h caml/startup_aux.h caml/sys.h
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h
str_npic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
- caml/misc.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
sys_npic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \
- caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/version.h caml/callback.h caml/startup_aux.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
unix_npic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \
- caml/alloc.h
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
weak_npic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
- caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \
- caml/signals.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h
win32_npic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h caml/config.h
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
# Lists of source files
-PRIMS := $(addsuffix .c, \
- alloc array compare extern floats gc_ctrl hash intern interp ints io \
- lexing md5 meta obj parsing signals str sys callback weak finalise \
- stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray)
-
BYTECODE_C_SOURCES := $(addsuffix .c, \
interp misc stacks fix_code startup_aux startup_byt freelist major_gc \
minor_gc memory alloc roots_byt globroots fail_byt signals \
signals_byt printexc backtrace_byt backtrace compare ints \
floats str array io extern intern hash sys meta parsing gc_ctrl md5 obj \
lexing callback debugger weak compact finalise custom dynlink \
- spacetime_byt afl $(UNIX_OR_WIN32) bigarray main)
+ spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain)
NATIVE_C_SOURCES := $(addsuffix .c, \
startup_aux startup_nat main fail_nat roots_nat signals \
floats str array io extern intern hash sys parsing gc_ctrl md5 obj \
lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \
globroots backtrace_nat backtrace dynlink_nat debugger meta \
- dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray)
+ dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray \
+ memprof domain)
# The other_files variable stores the list of files whose dependencies
# should be computed by `make depend` although they do not need to be
# than \UXXXXXXXX). The \u is then translated to \x in order to accommodate
# pre-Visual Studio 2013 compilers where \x is a non-standard alias for \u.
OCAML_STDLIB_DIR = $(shell echo $(LIBDIR)| iconv -t JAVA | sed -e 's/\\u/\\x/g')
-OC_CPPFLAGS += -DOCAML_STDLIB_DIR='L"$(OCAML_STDLIB_DIR)"'
+STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='L"$(OCAML_STDLIB_DIR)"'
else # Unix
OCAML_STDLIB_DIR = $(LIBDIR)
-OC_CPPFLAGS += -DOCAML_STDLIB_DIR='"$(OCAML_STDLIB_DIR)"'
+STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='"$(OCAML_STDLIB_DIR)"'
endif
OC_CPPFLAGS += $(IFLEXDIR)
$(INSTALL_PROG) $(BYTECODE_SHARED_LIBRARIES) "$(INSTALL_LIBDIR)"
endif
mkdir -p "$(INSTALL_INCDIR)"
- $(INSTALL_DATA) caml/*.h "$(INSTALL_INCDIR)"
+ $(INSTALL_DATA) caml/domain_state.tbl caml/*.h "$(INSTALL_INCDIR)"
.PHONY: installopt
installopt:
clean:
rm -f $(PROGRAMS) *.$(O) *.$(A) *.$(SO) ld.conf
rm -f primitives prims.c caml/opnames.h caml/jumptbl.h
- rm -f caml/version.h
+ rm -f caml/version.h domain_state*.inc
.PHONY: distclean
distclean: clean
# see http://pubs.opengroup.org/onlinepubs/9699919799/utilities/sort.html:
# "using sort to process pathnames, it is recommended that LC_ALL .. set to C"
-
-primitives : $(PRIMS)
- ./gen_primitives.sh >$@
+# To speed up builds, we avoid changing "primitives" when files
+# containing primitives change but the primitives table does not
+primitives: $(shell ./gen_primitives.sh > primitives.new; \
+ cmp -s primitives primitives.new || echo primitives.new)
+ cp $^ $@
prims.c : primitives
(echo '#define CAML_INTERNALS'; \
$(foreach object_type, $(object_types), \
$(eval $(call COMPILE_C_FILE,$(object_type))))
+dynlink_%.$(O): OC_CPPFLAGS += $(STDLIB_CPP_FLAG)
+
+$(foreach object_type,$(subst %,,$(object_types)), \
+ $(eval dynlink$(object_type).$(O): $(ROOTDIR)/Makefile.config))
+
# Compilation of assembly files
%.o: %.S
%_libasmrunpic.o: %.S
$(ASPP) $(ASPPFLAGS) $(SHAREDLIB_CFLAGS) -o $@ $<
-%.obj: %.asm
+domain_state64.inc: caml/domain_state.tbl gen_domain_state64_inc.awk
+ awk -f gen_domain_state64_inc.awk $< > $@
+
+domain_state32.inc: caml/domain_state.tbl gen_domain_state32_inc.awk
+ awk -f gen_domain_state32_inc.awk $< > $@
+
+amd64nt.obj: amd64nt.asm domain_state64.inc
+ $(ASM)$@ $(ASMFLAGS) $<
+
+i386nt.obj: i386nt.asm domain_state32.inc
$(ASM)$@ $(ASMFLAGS) $<
%_libasmrunpic.obj: %.asm
#include "caml/memory.h"
#include "caml/mlvalues.h"
#include "caml/stacks.h"
+#include "caml/signals.h"
#define Setup_for_gc
#define Restore_after_gc
#define G(r) _##r
#define GREL(r) _##r@GOTPCREL
#define GCALL(r) _##r
+#define TEXT_SECTION(name) .text
#define FUNCTION_ALIGN 2
#define EIGHT_ALIGN 3
#define SIXTEEN_ALIGN 4
#define G(r) r
#undef GREL
#define GCALL(r) r
+#define TEXT_SECTION(name)
#define FUNCTION_ALIGN 4
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
+ TEXT_SECTION(name); \
.globl name; \
.align FUNCTION_ALIGN; \
name:
#define G(r) r
#define GREL(r) r@GOTPCREL
#define GCALL(r) r@PLT
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#else
+#define TEXT_SECTION(name)
+#endif
#define FUNCTION_ALIGN 4
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
+ TEXT_SECTION(caml.##name); \
.globl name; \
.type name,@function; \
.align FUNCTION_ALIGN; \
#endif
+ .set domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+ .equ domain_field_caml_##name, domain_curr_field ; \
+ .set domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) (8*domain_field_caml_##var)(%r14)
+
#if defined(__PIC__) && !defined(SYS_mingw64) && !defined(SYS_cygwin)
/* Position-independent operations on global variables. */
#define RECORD_STACK_FRAME(OFFSET) \
pushq %r11 ; CFI_ADJUST(8); \
movq 8+OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_last_return_address) ; \
+ movq %rax, Caml_state(last_return_address) ; \
leaq 16+OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_bottom_of_stack) ; \
+ movq %rax, Caml_state(bottom_of_stack) ; \
popq %r11; CFI_ADJUST(-8)
/* Load address of global [label] in register [dst]. */
#define RECORD_STACK_FRAME(OFFSET) \
movq OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_last_return_address) ; \
+ movq %rax, Caml_state(last_return_address) ; \
leaq 8+OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_bottom_of_stack)
+ movq %rax, Caml_state(bottom_of_stack)
#define LEA_VAR(label,dst) \
leaq G(label)(%rip), dst
#else
# define PREPARE_FOR_C_CALL
# define CLEANUP_AFTER_C_CALL
-# define STACK_PROBE_SIZE 32768
+# define STACK_PROBE_SIZE 4096
#endif
/* Registers holding arguments of C functions. */
#define C_ARG_2 %rsi
#define C_ARG_3 %rdx
#define C_ARG_4 %rcx
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+ TEXT_SECTION(caml_hot__code_begin)
+ .globl G(caml_hot__code_begin)
+G(caml_hot__code_begin):
+
+ TEXT_SECTION(caml_hot__code_end)
+ .globl G(caml_hot__code_end)
+G(caml_hot__code_end):
#endif
.text
subq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE);
movq %rax, 0(%rsp)
addq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(-STACK_PROBE_SIZE);
- /* Build array of registers, save it into caml_gc_regs */
+ /* Build array of registers, save it into Caml_state->gc_regs */
#ifdef WITH_FRAME_POINTERS
ENTER_FUNCTION ;
#else
pushq %rdi; CFI_ADJUST (8);
pushq %rbx; CFI_ADJUST (8);
pushq %rax; CFI_ADJUST (8);
- STORE_VAR(%rsp, caml_gc_regs)
- /* Save caml_young_ptr, caml_exception_pointer */
- STORE_VAR(%r15, caml_young_ptr)
- STORE_VAR(%r14, caml_exception_pointer)
+ movq %rsp, Caml_state(gc_regs)
+ /* Save young_ptr */
+ movq %r15, Caml_state(young_ptr)
#ifdef WITH_SPACETIME
STORE_VAR(%r13, caml_spacetime_trie_node_ptr)
#endif
PREPARE_FOR_C_CALL
call GCALL(caml_garbage_collection)
CLEANUP_AFTER_C_CALL
- /* Restore caml_young_ptr, caml_exception_pointer */
- LOAD_VAR(caml_young_ptr, %r15)
- LOAD_VAR(caml_exception_pointer, %r14)
+ /* Restore young_ptr */
+ movq Caml_state(young_ptr), %r15
/* Restore all regs used by the code generator */
movsd 0*8(%rsp), %xmm0
movsd 1*8(%rsp), %xmm1
CFI_STARTPROC
LBL(caml_alloc1):
subq $16, %r15
- CMP_VAR(caml_young_limit, %r15)
+ cmpq Caml_state(young_limit), %r15
jb LBL(100)
ret
LBL(100):
+ addq $16, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
CFI_STARTPROC
LBL(caml_alloc2):
subq $24, %r15
- CMP_VAR(caml_young_limit, %r15)
+ cmpq Caml_state(young_limit), %r15
jb LBL(101)
ret
LBL(101):
+ addq $24, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
CFI_STARTPROC
LBL(caml_alloc3):
subq $32, %r15
- CMP_VAR(caml_young_limit, %r15)
+ cmpq Caml_state(young_limit), %r15
jb LBL(102)
ret
LBL(102):
+ addq $32, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8) */
LBL(caml_allocN):
pushq %rax; CFI_ADJUST(8) /* save desired size */
subq %rax, %r15
- CMP_VAR(caml_young_limit, %r15)
+ cmpq Caml_state(young_limit), %r15
jb LBL(103)
addq $8, %rsp; CFI_ADJUST (-8) /* drop desired size */
ret
LBL(103):
+ addq 0(%rsp), %r15
CFI_ADJUST(8)
RECORD_STACK_FRAME(8)
#ifdef WITH_FRAME_POINTERS
CFI_ENDPROC
ENDFUNCTION(G(caml_allocN))
+/* Reset the allocation pointer and invoke the GC */
+
+FUNCTION(G(caml_call_gc1))
+CFI_STARTPROC
+ addq $16, %r15
+ jmp GCALL(caml_call_gc)
+CFI_ENDPROC
+
+FUNCTION(G(caml_call_gc2))
+CFI_STARTPROC
+ addq $24, %r15
+ jmp GCALL(caml_call_gc)
+CFI_ENDPROC
+
+FUNCTION(G(caml_call_gc3))
+CFI_STARTPROC
+ addq $32, %r15
+ jmp GCALL(caml_call_gc)
+CFI_ENDPROC
+
+
/* Call a C function from OCaml */
FUNCTION(G(caml_c_call))
CFI_STARTPROC
LBL(caml_c_call):
/* Record lowest stack address and return address */
- popq %r12; CFI_ADJUST(-8)
- STORE_VAR(%r12, caml_last_return_address)
- STORE_VAR(%rsp, caml_bottom_of_stack)
+ popq Caml_state(last_return_address); CFI_ADJUST(-8)
+ movq %rsp, Caml_state(bottom_of_stack)
+ /* equivalent to pushing last return address */
+ subq $8, %rsp; CFI_ADJUST(8)
#ifdef WITH_SPACETIME
/* Record the trie node hole pointer that corresponds to
- [caml_last_return_address] */
+ [Caml_state->last_return_address] */
STORE_VAR(%r13, caml_spacetime_trie_node_ptr)
#endif
- subq $8, %rsp; CFI_ADJUST(8) /* equivalent to pushq %r12 */
/* Touch the stack to trigger a recoverable segfault
if insufficient space remains */
subq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE);
movq %rax, 0(%rsp)
addq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(-STACK_PROBE_SIZE);
- /* Make the exception handler and alloc ptr available to the C code */
- STORE_VAR(%r15, caml_young_ptr)
- STORE_VAR(%r14, caml_exception_pointer)
+ /* Make the alloc ptr available to the C code */
+ movq %r15, Caml_state(young_ptr)
/* Call the function (address in %rax) */
/* No need to PREPARE_FOR_C_CALL since the caller already
reserved the stack space if needed (cf. amd64/proc.ml) */
CFI_STARTPROC
/* Save callee-save registers */
PUSH_CALLEE_SAVE_REGS
+ /* Load Caml_state into r14 (was passed as an argument from C) */
+ movq C_ARG_1, %r14
/* Initial entry point is G(caml_program) */
LEA_VAR(caml_program, %r12)
/* Common code for caml_start_program and caml_callback* */
#else
subq $8, %rsp; CFI_ADJUST (8) /* stack 16-aligned */
#endif
- PUSH_VAR(caml_gc_regs)
- PUSH_VAR(caml_last_return_address)
- PUSH_VAR(caml_bottom_of_stack)
+ pushq Caml_state(gc_regs); CFI_ADJUST(8)
+ pushq Caml_state(last_return_address); CFI_ADJUST(8)
+ pushq Caml_state(bottom_of_stack); CFI_ADJUST(8)
#ifdef WITH_SPACETIME
/* Save arguments to caml_callback* */
pushq %rax; CFI_ADJUST (8)
popq %rbx; CFI_ADJUST (-8)
popq %rax; CFI_ADJUST (-8)
#endif
- /* Setup alloc ptr and exception ptr */
- LOAD_VAR(caml_young_ptr, %r15)
- LOAD_VAR(caml_exception_pointer, %r14)
+ /* Setup alloc ptr */
+ movq Caml_state(young_ptr), %r15
/* Build an exception handler */
lea LBL(108)(%rip), %r13
pushq %r13; CFI_ADJUST(8)
- pushq %r14; CFI_ADJUST(8)
- movq %rsp, %r14
+ pushq Caml_state(exception_pointer); CFI_ADJUST(8)
+ movq %rsp, Caml_state(exception_pointer)
#ifdef WITH_SPACETIME
LOAD_VAR(caml_spacetime_trie_node_ptr, %r13)
#endif
call *%r12
LBL(107):
/* Pop the exception handler */
- popq %r14; CFI_ADJUST(-8)
+ popq Caml_state(exception_pointer); CFI_ADJUST(-8)
popq %r12; CFI_ADJUST(-8) /* dummy register */
LBL(109):
- /* Update alloc ptr and exception ptr */
- STORE_VAR(%r15,caml_young_ptr)
- STORE_VAR(%r14,caml_exception_pointer)
+ /* Update alloc ptr */
+ movq %r15, Caml_state(young_ptr)
/* Pop the callback link, restoring the global variables */
- POP_VAR(caml_bottom_of_stack)
- POP_VAR(caml_last_return_address)
- POP_VAR(caml_gc_regs)
+ popq Caml_state(bottom_of_stack); CFI_ADJUST(-8)
+ popq Caml_state(last_return_address); CFI_ADJUST(-8)
+ popq Caml_state(gc_regs); CFI_ADJUST(-8)
#ifdef WITH_SPACETIME
POP_VAR(caml_spacetime_trie_node_ptr)
#else
FUNCTION(G(caml_raise_exn))
CFI_STARTPROC
- TESTL_VAR($1, caml_backtrace_active)
+ testq $1, Caml_state(backtrace_active)
jne LBL(110)
- movq %r14, %rsp
- popq %r14
+ movq Caml_state(exception_pointer), %rsp
+ popq Caml_state(exception_pointer); CFI_ADJUST(-8)
ret
LBL(110):
movq %rax, %r12 /* Save exception bucket */
popq C_ARG_2 /* arg 2: pc of raise */
movq %rsp, C_ARG_3 /* arg 3: sp at raise */
#endif
- movq %r14, C_ARG_4 /* arg 4: sp of handler */
+ /* arg 4: sp of handler */
+ movq Caml_state(exception_pointer), C_ARG_4
/* PR#5700: thanks to popq above, stack is now 16-aligned */
/* Thanks to ENTER_FUNCTION, stack is now 16-aligned */
PREPARE_FOR_C_CALL /* no need to cleanup after */
call GCALL(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
- movq %r14, %rsp
- popq %r14
+ movq Caml_state(exception_pointer), %rsp
+ popq Caml_state(exception_pointer); CFI_ADJUST(-8)
ret
CFI_ENDPROC
ENDFUNCTION(G(caml_raise_exn))
FUNCTION(G(caml_raise_exception))
CFI_STARTPROC
- TESTL_VAR($1, caml_backtrace_active)
+ movq C_ARG_1, %r14 /* Caml_state */
+ testq $1, Caml_state(backtrace_active)
jne LBL(112)
- movq C_ARG_1, %rax
- LOAD_VAR(caml_exception_pointer, %rsp) /* Cut stack */
- popq %r14 /* Recover previous exception handler */
- LOAD_VAR(caml_young_ptr, %r15) /* Reload alloc ptr */
+ movq C_ARG_2, %rax
+ movq Caml_state(exception_pointer), %rsp /* Cut stack */
+ /* Recover previous exception handler */
+ popq Caml_state(exception_pointer); CFI_ADJUST(-8)
+ movq Caml_state(young_ptr), %r15 /* Reload alloc ptr */
ret
LBL(112):
#ifdef WITH_FRAME_POINTERS
ENTER_FUNCTION ;
#endif
- movq C_ARG_1, %r12 /* Save exception bucket */
- /* arg 1: exception bucket */
- LOAD_VAR(caml_last_return_address,C_ARG_2) /* arg 2: pc of raise */
- LOAD_VAR(caml_bottom_of_stack,C_ARG_3) /* arg 3: sp of raise */
- LOAD_VAR(caml_exception_pointer,C_ARG_4) /* arg 4: sp of handler */
+ /* Save exception bucket. Caml_state in r14 saved across C calls. */
+ movq C_ARG_2, %r12
+ /* arg 1: exception bucket */
+ movq C_ARG_2, C_ARG_1
+ /* arg 2: pc of raise */
+ movq Caml_state(last_return_address), C_ARG_2
+ /* arg 3: sp of raise */
+ movq Caml_state(bottom_of_stack), C_ARG_3
+ /* arg 4: sp of handler */
+ movq Caml_state(exception_pointer), C_ARG_4
#ifndef WITH_FRAME_POINTERS
subq $8, %rsp /* PR#5700: maintain stack alignment */
#endif
PREPARE_FOR_C_CALL /* no need to cleanup after */
call GCALL(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
- LOAD_VAR(caml_exception_pointer,%rsp)
- popq %r14 /* Recover previous exception handler */
- LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */
+ movq Caml_state(exception_pointer), %rsp
+ /* Recover previous exception handler */
+ popq Caml_state(exception_pointer); CFI_ADJUST(-8)
+ movq Caml_state(young_ptr), %r15 /* Reload alloc ptr */
ret
CFI_ENDPROC
ENDFUNCTION(G(caml_raise_exception))
backtrace anyway. */
FUNCTION(G(caml_stack_overflow))
+ movq C_ARG_1, %r14 /* Caml_state */
LEA_VAR(caml_exn_Stack_overflow, %rax)
- movq %r14, %rsp /* cut the stack */
- popq %r14 /* recover previous exn handler */
- ret /* jump to handler's code */
+ movq Caml_state(exception_pointer), %rsp /* cut the stack */
+ /* Recover previous exn handler */
+ popq Caml_state(exception_pointer)
+ ret /* jump to handler's code */
ENDFUNCTION(G(caml_stack_overflow))
/* Callback from C to OCaml */
-FUNCTION(G(caml_callback_exn))
+FUNCTION(G(caml_callback_asm))
CFI_STARTPROC
/* Save callee-save registers */
PUSH_CALLEE_SAVE_REGS
/* Initial loading of arguments */
- movq C_ARG_1, %rbx /* closure */
- movq C_ARG_2, %rax /* argument */
+ movq C_ARG_1, %r14 /* Caml_state */
+ movq C_ARG_2, %rbx /* closure */
+ movq 0(C_ARG_3), %rax /* argument */
movq 0(%rbx), %r12 /* code pointer */
jmp LBL(caml_start_program)
CFI_ENDPROC
-ENDFUNCTION(G(caml_callback_exn))
+ENDFUNCTION(G(caml_callback_asm))
-FUNCTION(G(caml_callback2_exn))
+FUNCTION(G(caml_callback2_asm))
CFI_STARTPROC
/* Save callee-save registers */
PUSH_CALLEE_SAVE_REGS
/* Initial loading of arguments */
- movq C_ARG_1, %rdi /* closure -- no op with Unix conventions */
- movq C_ARG_2, %rax /* first argument */
- movq C_ARG_3, %rbx /* second argument */
+ movq C_ARG_1, %r14 /* Caml_state */
+ movq C_ARG_2, %rdi /* closure */
+ movq 0(C_ARG_3), %rax /* first argument */
+ movq 8(C_ARG_3), %rbx /* second argument */
LEA_VAR(caml_apply2, %r12) /* code pointer */
jmp LBL(caml_start_program)
CFI_ENDPROC
-ENDFUNCTION(G(caml_callback2_exn))
+ENDFUNCTION(G(caml_callback2_asm))
-FUNCTION(G(caml_callback3_exn))
+FUNCTION(G(caml_callback3_asm))
CFI_STARTPROC
/* Save callee-save registers */
PUSH_CALLEE_SAVE_REGS
/* Initial loading of arguments */
- movq C_ARG_2, %rax /* first argument */
- movq C_ARG_3, %rbx /* second argument */
- movq C_ARG_1, %rsi /* closure */
- movq C_ARG_4, %rdi /* third argument */
+ movq C_ARG_1, %r14 /* Caml_state */
+ movq 0(C_ARG_3), %rax /* first argument */
+ movq 8(C_ARG_3), %rbx /* second argument */
+ movq C_ARG_2, %rsi /* closure */
+ movq 16(C_ARG_3), %rdi /* third argument */
LEA_VAR(caml_apply3, %r12) /* code pointer */
jmp LBL(caml_start_program)
CFI_ENDPROC
-ENDFUNCTION(G(caml_callback3_exn))
+ENDFUNCTION(G(caml_callback3_asm))
FUNCTION(G(caml_ml_array_bound_error))
CFI_STARTPROC
EXTRN caml_apply3: NEAR
EXTRN caml_program: NEAR
EXTRN caml_array_bound_error: NEAR
- EXTRN caml_young_limit: QWORD
- EXTRN caml_young_ptr: QWORD
- EXTRN caml_bottom_of_stack: QWORD
- EXTRN caml_last_return_address: QWORD
- EXTRN caml_gc_regs: QWORD
- EXTRN caml_exception_pointer: QWORD
- EXTRN caml_backtrace_pos: DWORD
- EXTRN caml_backtrace_active: DWORD
- EXTRN caml_stash_backtrace: NEAR
+ EXTRN caml_stash_backtrace: NEAR
IFDEF WITH_SPACETIME
EXTRN caml_spacetime_trie_node_ptr: QWORD
EXTRN caml_spacetime_c_to_ocaml: NEAR
ENDIF
+INCLUDE domain_state64.inc
+
.CODE
PUBLIC caml_system__code_begin
caml_call_gc:
; Record lowest stack address and return address
mov rax, [rsp]
- mov caml_last_return_address, rax
+ Store_last_return_address rax
lea rax, [rsp+8]
- mov caml_bottom_of_stack, rax
+ Store_bottom_of_stack rax
L105:
; Touch the stack to trigger a recoverable segfault
; if insufficient space remains
sub rsp, 01000h
mov [rsp], rax
add rsp, 01000h
- ; Save caml_young_ptr, caml_exception_pointer
- mov caml_young_ptr, r15
- mov caml_exception_pointer, r14
+ ; Save young_ptr
+ Store_young_ptr r15
IFDEF WITH_SPACETIME
mov caml_spacetime_trie_node_ptr, r13
ENDIF
- ; Build array of registers, save it into caml_gc_regs
+ ; Build array of registers, save it into Caml_state(gc_regs)
push rbp
push r11
push r10
push rdi
push rbx
push rax
- mov caml_gc_regs, rsp
+ Store_gc_regs rsp
; Save floating-point registers
sub rsp, 16*8
movsd QWORD PTR [rsp + 0*8], xmm0
pop r10
pop r11
pop rbp
- ; Restore caml_young_ptr, caml_exception_pointer
- mov r15, caml_young_ptr
- mov r14, caml_exception_pointer
+ ; Restore Caml_state(young_ptr)
+ Load_young_ptr r15
; Return to caller
ret
ALIGN 16
caml_alloc1:
sub r15, 16
- cmp r15, caml_young_limit
+ Cmp_young_limit r15
jb L100
ret
L100:
+ add r15, 16
mov rax, [rsp + 0]
- mov caml_last_return_address, rax
+ Store_last_return_address rax
lea rax, [rsp + 8]
- mov caml_bottom_of_stack, rax
+ Store_bottom_of_stack rax
sub rsp, 8
call L105
add rsp, 8
ALIGN 16
caml_alloc2:
sub r15, 24
- cmp r15, caml_young_limit
+ Cmp_young_limit r15
jb L101
ret
L101:
+ add r15, 24
mov rax, [rsp + 0]
- mov caml_last_return_address, rax
+ Store_last_return_address rax
lea rax, [rsp + 8]
- mov caml_bottom_of_stack, rax
+ Store_bottom_of_stack rax
sub rsp, 8
call L105
add rsp, 8
ALIGN 16
caml_alloc3:
sub r15, 32
- cmp r15, caml_young_limit
+ Cmp_young_limit r15
jb L102
ret
L102:
+ add r15, 32
mov rax, [rsp + 0]
- mov caml_last_return_address, rax
+ Store_last_return_address rax
lea rax, [rsp + 8]
- mov caml_bottom_of_stack, rax
+ Store_bottom_of_stack rax
sub rsp, 8
call L105
add rsp, 8
ALIGN 16
caml_allocN:
sub r15, rax
- cmp r15, caml_young_limit
+ Cmp_young_limit r15
jb L103
ret
L103:
+ add r15, rax
push rax ; save desired size
mov rax, [rsp + 8]
- mov caml_last_return_address, rax
+ Store_last_return_address rax
lea rax, [rsp + 16]
- mov caml_bottom_of_stack, rax
+ Store_bottom_of_stack rax
call L105
pop rax ; recover desired size
jmp caml_allocN
+; Reset the allocation pointer and invoke the GC
+
+ PUBLIC caml_call_gc1
+ ALIGN 16
+caml_call_gc1:
+ add r15, 16
+ jmp caml_call_gc
+
+ PUBLIC caml_call_gc2
+ ALIGN 16
+caml_call_gc2:
+ add r15, 24
+ jmp caml_call_gc
+
+ PUBLIC caml_call_gc3
+ ALIGN 16
+caml_call_gc3:
+ add r15, 32
+ jmp caml_call_gc
+
; Call a C function from OCaml
PUBLIC caml_c_call
caml_c_call:
; Record lowest stack address and return address
pop r12
- mov caml_last_return_address, r12
- mov caml_bottom_of_stack, rsp
+ Store_last_return_address r12
+ Store_bottom_of_stack rsp
IFDEF WITH_SPACETIME
; Record the trie node hole pointer that corresponds to
- ; [caml_last_return_address]
+ ; [Caml_state(last_return_address)]
mov caml_spacetime_trie_node_ptr, r13
ENDIF
; Touch the stack to trigger a recoverable segfault
sub rsp, 01000h
mov [rsp], rax
add rsp, 01000h
- ; Make the exception handler and alloc ptr available to the C code
- mov caml_young_ptr, r15
- mov caml_exception_pointer, r14
+ ; Make the alloc ptr available to the C code
+ Store_young_ptr r15
; Call the function (address in rax)
call rax
; Reload alloc ptr
- mov r15, caml_young_ptr
+ Load_young_ptr r15
; Return to caller
push r12
ret
movapd OWORD PTR [rsp + 7*16], xmm13
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
+ ; First argument (rcx) is Caml_state. Load it in r14
+ mov r14, rcx
; Initial entry point is caml_program
lea r12, caml_program
; Common code for caml_start_program and caml_callback*
ELSE
sub rsp, 8 ; stack 16-aligned
ENDIF
- push caml_gc_regs
- push caml_last_return_address
- push caml_bottom_of_stack
+ Push_gc_regs
+ Push_last_return_address
+ Push_bottom_of_stack
IFDEF WITH_SPACETIME
; Save arguments to caml_callback
push rax
pop rbx
pop rax
ENDIF
- ; Setup alloc ptr and exception ptr
- mov r15, caml_young_ptr
- mov r14, caml_exception_pointer
+ ; Setup alloc ptr
+ Load_young_ptr r15
; Build an exception handler
lea r13, L108
push r13
- push r14
- mov r14, rsp
+ Push_exception_pointer
+ Store_exception_pointer rsp
IFDEF WITH_SPACETIME
mov r13, caml_spacetime_trie_node_ptr
ENDIF
call r12
L107:
; Pop the exception handler
- pop r14
+ Pop_exception_pointer
pop r12 ; dummy register
L109:
- ; Update alloc ptr and exception ptr
- mov caml_young_ptr, r15
- mov caml_exception_pointer, r14
+ ; Update alloc ptr
+ Store_young_ptr r15
; Pop the callback restoring, link the global variables
- pop caml_bottom_of_stack
- pop caml_last_return_address
- pop caml_gc_regs
+ Pop_bottom_of_stack
+ Pop_last_return_address
+ Pop_gc_regs
IFDEF WITH_SPACETIME
pop caml_spacetime_trie_node_ptr
ELSE
PUBLIC caml_raise_exn
ALIGN 16
caml_raise_exn:
- test caml_backtrace_active, 1
+ Load_backtrace_active r11
+ test r11, 1
jne L110
- mov rsp, r14 ; Cut stack
- pop r14 ; Recover previous exception handler
- ret ; Branch to handler
+ Load_exception_pointer rsp ; Cut stack
+ ; Recover previous exception handler
+ Pop_exception_pointer
+ ret ; Branch to handler
L110:
mov r12, rax ; Save exception bucket in r12
mov rcx, rax ; Arg 1: exception bucket
mov rdx, [rsp] ; Arg 2: PC of raise
lea r8, [rsp+8] ; Arg 3: SP of raise
- mov r9, r14 ; Arg 4: SP of handler
+ Load_exception_pointer r9 ; Arg 4: SP of handler
sub rsp, 32 ; Reserve 32 bytes on stack
call caml_stash_backtrace
mov rax, r12 ; Recover exception bucket
- mov rsp, r14 ; Cut stack
- pop r14 ; Recover previous exception handler
+ Load_exception_pointer rsp ; Cut stack
+ ; Recover previous exception handler
+ Pop_exception_pointer
ret ; Branch to handler
; Raise an exception from C
PUBLIC caml_raise_exception
ALIGN 16
caml_raise_exception:
- test caml_backtrace_active, 1
+ mov r14, rcx ; First argument is Caml_state
+ Load_backtrace_active r11
+ test r11, 1
jne L112
- mov rax, rcx ; First argument is exn bucket
- mov rsp, caml_exception_pointer
- pop r14 ; Recover previous exception handler
- mov r15, caml_young_ptr ; Reload alloc ptr
+ mov rax, rdx ; Second argument is exn bucket
+ Load_exception_pointer rsp
+ ; Recover previous exception handler
+ Pop_exception_pointer
+ Load_young_ptr r15 ; Reload alloc ptr
ret
L112:
- mov r12, rcx ; Save exception bucket in r12
- ; Arg 1: exception bucket
- mov rdx, caml_last_return_address ; Arg 2: PC of raise
- mov r8, caml_bottom_of_stack ; Arg 3: SP of raise
- mov r9, caml_exception_pointer ; Arg 4: SP of handler
+ mov r12, rdx ; Save exception bucket in r12
+ mov rcx, rdx ; Arg 1: exception bucket
+ Load_last_return_address rdx ; Arg 2: PC of raise
+ Load_bottom_of_stack r8 ; Arg 3: SP of raise
+ Load_exception_pointer r9 ; Arg 4: SP of handler
sub rsp, 32 ; Reserve 32 bytes on stack
call caml_stash_backtrace
mov rax, r12 ; Recover exception bucket
- mov rsp, caml_exception_pointer
- pop r14 ; Recover previous exception handler
- mov r15, caml_young_ptr ; Reload alloc ptr
+ Load_exception_pointer rsp
+ ; Recover previous exception handler
+ Pop_exception_pointer
+ Load_young_ptr r15; Reload alloc ptr
ret
; Callback from C to OCaml
- PUBLIC caml_callback_exn
+ PUBLIC caml_callback_asm
ALIGN 16
-caml_callback_exn:
+caml_callback_asm:
; Save callee-save registers
push rbx
push rbp
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial loading of arguments
- mov rbx, rcx ; closure
- mov rax, rdx ; argument
+ mov r14, rcx ; Caml_state
+ mov rbx, rdx ; closure
+ mov rax, [r8] ; argument
mov r12, [rbx] ; code pointer
jmp L106
- PUBLIC caml_callback2_exn
+ PUBLIC caml_callback2_asm
ALIGN 16
-caml_callback2_exn:
+caml_callback2_asm:
; Save callee-save registers
push rbx
push rbp
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial loading of arguments
- mov rdi, rcx ; closure
- mov rax, rdx ; first argument
- mov rbx, r8 ; second argument
+ mov r14, rcx ; Caml_state
+ mov rdi, rdx ; closure
+ mov rax, [r8] ; first argument
+ mov rbx, [r8 + 8] ; second argument
lea r12, caml_apply2 ; code pointer
jmp L106
- PUBLIC caml_callback3_exn
+ PUBLIC caml_callback3_asm
ALIGN 16
-caml_callback3_exn:
+caml_callback3_asm:
; Save callee-save registers
push rbx
push rbp
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial loading of arguments
- mov rsi, rcx ; closure
- mov rax, rdx ; first argument
- mov rbx, r8 ; second argument
- mov rdi, r9 ; third argument
+ mov r14, rcx ; Caml_state
+ mov rsi, rdx ; closure
+ mov rax, [r8] ; first argument
+ mov rbx, [r8 + 8] ; second argument
+ mov rdi, [r8 + 16] ; third argument
lea r12, caml_apply3 ; code pointer
jmp L106
.endm
#endif
-trap_ptr .req r8
-alloc_ptr .req r10
-alloc_limit .req r11
+trap_ptr .req r8
+alloc_ptr .req r10
+domain_state_ptr .req r11
/* Support for CFI directives */
#define CFI_OFFSET(r,n)
#endif
-/* Allocation functions and GC interface */
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#else
+#define TEXT_SECTION(name)
+#endif
+
+#define FUNCTION(name) \
+ TEXT_SECTION(caml.##name); \
+ .align 2; \
+ .globl name; \
+ .type name, %function; \
+name:
+
+#if defined(FUNCTION_SECTIONS)
+ TEXT_SECTION(caml_hot__code_begin)
+ .globl caml_hot__code_begin
+caml_hot__code_begin:
+
+ TEXT_SECTION(caml_hot__code_end)
+ .globl caml_hot__code_end
+caml_hot__code_end:
+#endif
+
+ .set domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+ .equ domain_field_caml_##name, domain_curr_field ; \
+ .set domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+#define Caml_state(var) [domain_state_ptr, 8*domain_field_caml_##var]
+
+/* Allocation functions and GC interface */
.globl caml_system__code_begin
caml_system__code_begin:
- .align 2
- .globl caml_call_gc
-caml_call_gc:
+FUNCTION(caml_call_gc)
CFI_STARTPROC
/* Record return address */
- ldr r12, =caml_last_return_address
- str lr, [r12]
+ str lr, Caml_state(last_return_address)
.Lcaml_call_gc:
/* Record lowest stack address */
- ldr r12, =caml_bottom_of_stack
- str sp, [r12]
+ str sp, Caml_state(bottom_of_stack)
#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
/* Save caller floating-point registers on the stack */
vpush {d0-d7}; CFI_ADJUST(64)
#else
CFI_OFFSET(lr, -4)
#endif
- /* Store pointer to saved integer registers in caml_gc_regs */
- ldr r12, =caml_gc_regs
- str sp, [r12]
+ /* Store pointer to saved integer registers in Caml_state->gc_regs */
+ str sp, Caml_state(gc_regs)
/* Save current allocation pointer for debugging purposes */
- ldr alloc_limit, =caml_young_ptr
- str alloc_ptr, [alloc_limit]
+ str alloc_ptr, Caml_state(young_ptr)
/* Save trap pointer in case an exception is raised during GC */
- ldr r12, =caml_exception_pointer
- str trap_ptr, [r12]
+ str trap_ptr, Caml_state(exception_pointer)
/* Call the garbage collector */
bl caml_garbage_collection
/* Restore integer registers and return address from the stack */
/* Restore floating-point registers from the stack */
vpop {d0-d7}; CFI_ADJUST(-64)
#endif
- /* Reload new allocation pointer and limit */
- /* alloc_limit still points to caml_young_ptr */
- ldr r12, =caml_young_limit
- ldr alloc_ptr, [alloc_limit]
- ldr alloc_limit, [r12]
+ /* Reload new allocation pointer */
+ ldr alloc_ptr, Caml_state(young_ptr)
/* Return to caller */
bx lr
CFI_ENDPROC
- .type caml_call_gc, %function
.size caml_call_gc, .-caml_call_gc
- .align 2
- .globl caml_alloc1
-caml_alloc1:
+FUNCTION(caml_alloc1)
CFI_STARTPROC
.Lcaml_alloc1:
sub alloc_ptr, alloc_ptr, 8
- cmp alloc_ptr, alloc_limit
+ ldr r7, Caml_state(young_limit)
+ cmp alloc_ptr, r7
bcc 1f
bx lr
-1: /* Record return address */
- ldr r7, =caml_last_return_address
- str lr, [r7]
- /* Call GC (preserves r7) */
+1: add alloc_ptr, alloc_ptr, 8
+ /* Record return address */
+ str lr, Caml_state(last_return_address)
+ /* Call GC */
bl .Lcaml_call_gc
/* Restore return address */
- ldr lr, [r7]
+ ldr lr, Caml_state(last_return_address)
/* Try again */
b .Lcaml_alloc1
CFI_ENDPROC
- .type caml_alloc1, %function
.size caml_alloc1, .-caml_alloc1
- .align 2
- .globl caml_alloc2
-caml_alloc2:
+FUNCTION(caml_alloc2)
CFI_STARTPROC
.Lcaml_alloc2:
sub alloc_ptr, alloc_ptr, 12
- cmp alloc_ptr, alloc_limit
+ ldr r7, Caml_state(young_limit)
+ cmp alloc_ptr, r7
bcc 1f
bx lr
-1: /* Record return address */
- ldr r7, =caml_last_return_address
- str lr, [r7]
- /* Call GC (preserves r7) */
+1: add alloc_ptr, alloc_ptr, 12
+ /* Record return address */
+ str lr, Caml_state(last_return_address)
+ /* Call GC */
bl .Lcaml_call_gc
/* Restore return address */
- ldr lr, [r7]
+ ldr lr, Caml_state(last_return_address)
/* Try again */
b .Lcaml_alloc2
CFI_ENDPROC
- .type caml_alloc2, %function
.size caml_alloc2, .-caml_alloc2
- .align 2
- .globl caml_alloc3
- .type caml_alloc3, %function
-caml_alloc3:
+FUNCTION(caml_alloc3)
CFI_STARTPROC
.Lcaml_alloc3:
sub alloc_ptr, alloc_ptr, 16
- cmp alloc_ptr, alloc_limit
+ ldr r7, Caml_state(young_limit)
+ cmp alloc_ptr, r7
bcc 1f
bx lr
-1: /* Record return address */
- ldr r7, =caml_last_return_address
- str lr, [r7]
- /* Call GC (preserves r7) */
+1: add alloc_ptr, alloc_ptr, 16
+ /* Record return address */
+ str lr, Caml_state(last_return_address)
+ /* Call GC */
bl .Lcaml_call_gc
/* Restore return address */
- ldr lr, [r7]
+ ldr lr, Caml_state(last_return_address)
/* Try again */
b .Lcaml_alloc3
CFI_ENDPROC
- .type caml_alloc3, %function
.size caml_alloc3, .-caml_alloc3
- .align 2
- .globl caml_allocN
-caml_allocN:
+FUNCTION(caml_allocN)
CFI_STARTPROC
.Lcaml_allocN:
sub alloc_ptr, alloc_ptr, r7
- cmp alloc_ptr, alloc_limit
+ ldr r12, Caml_state(young_limit)
+ cmp alloc_ptr, r12
bcc 1f
bx lr
-1: /* Record return address */
- ldr r12, =caml_last_return_address
- str lr, [r12]
+1: add alloc_ptr, alloc_ptr, r7
+ /* Record return address */
+ str lr, Caml_state(last_return_address)
/* Call GC (preserves r7) */
bl .Lcaml_call_gc
/* Restore return address */
- ldr r12, =caml_last_return_address
- ldr lr, [r12]
+ ldr lr, Caml_state(last_return_address)
/* Try again */
b .Lcaml_allocN
CFI_ENDPROC
- .type caml_allocN, %function
.size caml_allocN, .-caml_allocN
/* Call a C function from OCaml */
/* Function to call is in r7 */
- .align 2
- .globl caml_c_call
-caml_c_call:
+FUNCTION(caml_c_call)
CFI_STARTPROC
/* Record lowest stack address and return address */
- ldr r5, =caml_last_return_address
- ldr r6, =caml_bottom_of_stack
- str lr, [r5]
- str sp, [r6]
+ str lr, Caml_state(last_return_address)
+ str sp, Caml_state(bottom_of_stack)
/* Preserve return address in callee-save register r4 */
mov r4, lr
CFI_REGISTER(lr, r4)
/* Make the exception handler alloc ptr available to the C code */
- ldr r5, =caml_young_ptr
- ldr r6, =caml_exception_pointer
- str alloc_ptr, [r5]
- str trap_ptr, [r6]
+ str alloc_ptr, Caml_state(young_ptr)
+ str trap_ptr, Caml_state(exception_pointer)
/* Call the function */
blx r7
- /* Reload alloc ptr and alloc limit */
- ldr r6, =caml_young_limit
- ldr alloc_ptr, [r5] /* r5 still points to caml_young_ptr */
- ldr alloc_limit, [r6]
+ /* Reload alloc ptr */
+ ldr alloc_ptr, Caml_state(young_ptr)
/* Return */
bx r4
CFI_ENDPROC
- .type caml_c_call, %function
.size caml_c_call, .-caml_c_call
/* Start the OCaml program */
- .align 2
- .globl caml_start_program
-caml_start_program:
+FUNCTION(caml_start_program)
CFI_STARTPROC
ldr r12, =caml_program
#else
CFI_OFFSET(lr, -4)
#endif
+ ldr domain_state_ptr, =Caml_state
+ ldr domain_state_ptr, [domain_state_ptr]
/* Setup a callback link on the stack */
sub sp, sp, 16; CFI_ADJUST(16) /* 8-byte alignment */
- ldr r4, =caml_bottom_of_stack
- ldr r5, =caml_last_return_address
- ldr r6, =caml_gc_regs
- ldr r4, [r4]
- ldr r5, [r5]
- ldr r6, [r6]
+ ldr r4, Caml_state(bottom_of_stack)
+ ldr r5, Caml_state(last_return_address)
+ ldr r6, Caml_state(gc_regs)
str r4, [sp, 0]
str r5, [sp, 4]
str r6, [sp, 8]
/* Setup a trap frame to catch exceptions escaping the OCaml code */
sub sp, sp, 8; CFI_ADJUST(8)
- ldr r6, =caml_exception_pointer
ldr r5, =.Ltrap_handler
- ldr r4, [r6]
+ ldr r4, Caml_state(exception_pointer)
str r4, [sp, 0]
str r5, [sp, 4]
mov trap_ptr, sp
- /* Reload allocation pointers */
- ldr r4, =caml_young_ptr
- ldr alloc_ptr, [r4]
- ldr r4, =caml_young_limit
- ldr alloc_limit, [r4]
+ /* Reload allocation pointer */
+ ldr alloc_ptr, Caml_state(young_ptr)
/* Call the OCaml code */
blx r12
.Lcaml_retaddr:
/* Pop the trap frame, restoring caml_exception_pointer */
- ldr r4, =caml_exception_pointer
ldr r5, [sp, 0]
- str r5, [r4]
+ str r5, Caml_state(exception_pointer)
add sp, sp, 8; CFI_ADJUST(-8)
/* Pop the callback link, restoring the global variables */
.Lreturn_result:
- ldr r4, =caml_bottom_of_stack
ldr r5, [sp, 0]
- str r5, [r4]
- ldr r4, =caml_last_return_address
+ str r5, Caml_state(bottom_of_stack)
ldr r5, [sp, 4]
- str r5, [r4]
- ldr r4, =caml_gc_regs
+ str r5, Caml_state(last_return_address)
ldr r5, [sp, 8]
- str r5, [r4]
+ str r5, Caml_state(gc_regs)
add sp, sp, 16; CFI_ADJUST(-16)
/* Update allocation pointer */
- ldr r4, =caml_young_ptr
- str alloc_ptr, [r4]
+ str alloc_ptr, Caml_state(young_ptr)
/* Reload callee-save registers and return address */
pop {r4-r8,r10,r11,lr}; CFI_ADJUST(-32)
#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
CFI_ENDPROC
.type .Lcaml_retaddr, %function
.size .Lcaml_retaddr, .-.Lcaml_retaddr
- .type caml_start_program, %function
.size caml_start_program, .-caml_start_program
/* The trap handler */
.Ltrap_handler:
CFI_STARTPROC
/* Save exception pointer */
- ldr r12, =caml_exception_pointer
- str trap_ptr, [r12]
+ str trap_ptr, Caml_state(exception_pointer)
/* Encode exception bucket as an exception result */
orr r0, r0, 2
/* Return it */
/* Raise an exception from OCaml */
- .align 2
- .globl caml_raise_exn
-caml_raise_exn:
+FUNCTION(caml_raise_exn)
CFI_STARTPROC
/* Test if backtrace is active */
- ldr r1, =caml_backtrace_active
- ldr r1, [r1]
+ ldr r1, Caml_state(backtrace_active)
cbz r1, 1f
/* Preserve exception bucket in callee-save register r4 */
mov r4, r0
/* Pop previous handler and addr of trap, and jump to it */
pop {trap_ptr, pc}
CFI_ENDPROC
- .type caml_raise_exn, %function
.size caml_raise_exn, .-caml_raise_exn
/* Raise an exception from C */
- .align 2
- .globl caml_raise_exception
-caml_raise_exception:
+FUNCTION(caml_raise_exception)
CFI_STARTPROC
- /* Reload trap ptr, alloc ptr and alloc limit */
- ldr trap_ptr, =caml_exception_pointer
- ldr alloc_ptr, =caml_young_ptr
- ldr alloc_limit, =caml_young_limit
- ldr trap_ptr, [trap_ptr]
- ldr alloc_ptr, [alloc_ptr]
- ldr alloc_limit, [alloc_limit]
+ /* Load the domain state ptr */
+ mov domain_state_ptr, r0
+ /* Load exception bucket */
+ mov r0, r1
+ /* Reload trap ptr and alloc ptr */
+ ldr trap_ptr, Caml_state(exception_pointer)
+ ldr alloc_ptr, Caml_state(young_ptr)
/* Test if backtrace is active */
- ldr r1, =caml_backtrace_active
- ldr r1, [r1]
+ ldr r1, Caml_state(backtrace_active)
cbz r1, 1f
/* Preserve exception bucket in callee-save register r4 */
mov r4, r0
- ldr r1, =caml_last_return_address /* arg2: pc of raise */
- ldr r1, [r1]
- ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */
- ldr r2, [r2]
- mov r3, trap_ptr /* arg4: sp of handler */
+ ldr r1, Caml_state(last_return_address) /* arg2: pc of raise */
+ ldr r2, Caml_state(bottom_of_stack) /* arg3: sp of raise */
+ mov r3, trap_ptr /* arg4: sp of handler */
bl caml_stash_backtrace
/* Restore exception bucket */
mov r0, r4
/* Pop previous handler and addr of trap, and jump to it */
pop {trap_ptr, pc}
CFI_ENDPROC
- .type caml_raise_exception, %function
.size caml_raise_exception, .-caml_raise_exception
/* Callback from C to OCaml */
- .align 2
- .globl caml_callback_exn
-caml_callback_exn:
+FUNCTION(caml_callback_asm)
CFI_STARTPROC
- /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */
- mov r12, r0
- mov r0, r1 /* r0 = first arg */
- mov r1, r12 /* r1 = closure environment */
- ldr r12, [r12] /* code pointer */
+ /* Initial shuffling of arguments */
+ /* (r0 = Caml_state, r1 = closure, [r2] = first arg) */
+ ldr r0, [r2] /* r0 = first arg */
+ /* r1 = closure environment */
+ ldr r12, [r1] /* code pointer */
b .Ljump_to_caml
CFI_ENDPROC
- .type caml_callback_exn, %function
- .size caml_callback_exn, .-caml_callback_exn
+ .size caml_callback_asm, .-caml_callback_asm
- .align 2
- .globl caml_callback2_exn
-caml_callback2_exn:
+FUNCTION(caml_callback2_asm)
CFI_STARTPROC
- /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */
- mov r12, r0
- mov r0, r1 /* r0 = first arg */
- mov r1, r2 /* r1 = second arg */
- mov r2, r12 /* r2 = closure environment */
+ /* Initial shuffling of arguments */
+ /* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2) */
+ mov r12, r1
+ ldr r0, [r2] /* r0 = first arg */
+ ldr r1, [r2,4] /* r1 = second arg */
+ mov r2, r12 /* r2 = closure environment */
ldr r12, =caml_apply2
b .Ljump_to_caml
CFI_ENDPROC
- .type caml_callback2_exn, %function
- .size caml_callback2_exn, .-caml_callback2_exn
+ .size caml_callback2_asm, .-caml_callback2_asm
- .align 2
- .globl caml_callback3_exn
-caml_callback3_exn:
+FUNCTION(caml_callback3_asm)
CFI_STARTPROC
/* Initial shuffling of arguments */
- /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */
- mov r12, r0
- mov r0, r1 /* r0 = first arg */
- mov r1, r2 /* r1 = second arg */
- mov r2, r3 /* r2 = third arg */
- mov r3, r12 /* r3 = closure environment */
+ /* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2,
+ [r2,8] = arg3) */
+ mov r3, r1 /* r3 = closure environment */
+ ldr r0, [r2] /* r0 = first arg */
+ ldr r1, [r2,4] /* r1 = second arg */
+ ldr r2, [r2,8] /* r2 = third arg */
ldr r12, =caml_apply3
b .Ljump_to_caml
CFI_ENDPROC
- .type caml_callback3_exn, %function
- .size caml_callback3_exn, .-caml_callback3_exn
+ .size caml_callback3_asm, .-caml_callback3_asm
- .align 2
- .globl caml_ml_array_bound_error
-caml_ml_array_bound_error:
+FUNCTION(caml_ml_array_bound_error)
CFI_STARTPROC
/* Load address of [caml_array_bound_error] in r7 */
ldr r7, =caml_array_bound_error
/* Call that function */
b caml_c_call
CFI_ENDPROC
- .type caml_ml_array_bound_error, %function
.size caml_ml_array_bound_error, .-caml_ml_array_bound_error
.globl caml_system__code_end
/* Special registers */
+#define DOMAIN_STATE_PTR x25
#define TRAP_PTR x26
#define ALLOC_PTR x27
#define ALLOC_LIMIT x28
#define ARG x15
#define TMP x16
#define TMP2 x17
+#define ARG_DOMAIN_STATE_PTR x18
+
+#define C_ARG_1 x0
+#define C_ARG_2 x1
+#define C_ARG_3 x2
+#define C_ARG_4 x3
/* Support for CFI directives */
#define CFI_OFFSET(r,n)
#endif
-/* Macros to load and store global variables. Destroy TMP2 */
+ .set domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+ .equ domain_field_caml_##name, domain_curr_field ; \
+ .set domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) [x25, 8*domain_field_caml_##var]
#if defined(__PIC__)
#define ADDRGLOBAL(reg,symb) \
adrp TMP2, :got:symb; \
ldr reg, [TMP2, #:got_lo12:symb]
-
-#define LOADGLOBAL(reg,symb) \
- ADDRGLOBAL(TMP2,symb); \
- ldr reg, [TMP2]
-
-#define STOREGLOBAL(reg,symb) \
- ADDRGLOBAL(TMP2,symb); \
- str reg, [TMP2]
-
-#define LOADGLOBAL32(reg,symb) \
- ADDRGLOBAL(TMP2,symb); \
- ldrsw reg, [TMP2]
-
#else
#define ADDRGLOBAL(reg,symb) \
adrp reg, symb; \
add reg, reg, #:lo12:symb
-#define LOADGLOBAL(reg,symb) \
- adrp TMP2, symb; \
- ldr reg, [TMP2, #:lo12:symb]
+#endif
-#define STOREGLOBAL(reg,symb) \
- adrp TMP2, symb; \
- str reg, [TMP2, #:lo12:symb]
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#else
+#define TEXT_SECTION(name)
+#endif
-#define LOADGLOBAL32(reg,symb) \
- adrp TMP2, symb; \
- ldrsw reg, [TMP2, #:lo12:symb]
+#if defined(FUNCTION_SECTIONS)
+ TEXT_SECTION(caml_hot__code_begin)
+ .globl caml_hot__code_begin
+caml_hot__code_begin:
+ TEXT_SECTION(caml_hot__code_end)
+ .globl caml_hot__code_end
+caml_hot__code_end:
#endif
-/* Allocation functions and GC interface */
+#define FUNCTION(name) \
+ TEXT_SECTION(caml.##name); \
+ .align 2; \
+ .globl name; \
+ .type name, %function; \
+name:
+/* Allocation functions and GC interface */
.globl caml_system__code_begin
caml_system__code_begin:
- .align 2
- .globl caml_call_gc
-caml_call_gc:
+FUNCTION(caml_call_gc)
CFI_STARTPROC
/* Record return address */
- STOREGLOBAL(x30, caml_last_return_address)
+ str x30, Caml_state(last_return_address)
/* Record lowest stack address */
mov TMP, sp
- STOREGLOBAL(TMP, caml_bottom_of_stack)
+ str TMP, Caml_state(bottom_of_stack)
.Lcaml_call_gc:
/* Set up stack space, saving return address and frame pointer */
/* (2 regs RA/GP, 24 allocatable int regs, 24 caller-save float regs) * 8 */
stp d26, d27, [sp, 352]
stp d28, d29, [sp, 368]
stp d30, d31, [sp, 384]
- /* Store pointer to saved integer registers in caml_gc_regs */
+ /* Store pointer to saved integer registers in Caml_state->gc_regs */
add TMP, sp, #16
- STOREGLOBAL(TMP, caml_gc_regs)
+ str TMP, Caml_state(gc_regs)
/* Save current allocation pointer for debugging purposes */
- STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
+ str ALLOC_PTR, Caml_state(young_ptr)
/* Save trap pointer in case an exception is raised during GC */
- STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
+ str TRAP_PTR, Caml_state(exception_pointer)
/* Call the garbage collector */
bl caml_garbage_collection
/* Restore registers */
ldp d28, d29, [sp, 368]
ldp d30, d31, [sp, 384]
/* Reload new allocation pointer and allocation limit */
- LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
- LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
+ ldr ALLOC_PTR, Caml_state(young_ptr)
+ ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Free stack space and return to caller */
ldp x29, x30, [sp], 400
ret
CFI_ENDPROC
- .type caml_call_gc, %function
.size caml_call_gc, .-caml_call_gc
- .align 2
- .globl caml_alloc1
-caml_alloc1:
+FUNCTION(caml_alloc1)
CFI_STARTPROC
1: sub ALLOC_PTR, ALLOC_PTR, #16
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
-2: stp x29, x30, [sp, -16]!
+2: add ALLOC_PTR, ALLOC_PTR, #16
+ stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame. This is the
address immediately above the pair of words (x29 and x30) we just
pushed. Those must not be included since otherwise the distance from
- [caml_bottom_of_stack] to the highest address in the caller's stack
- frame won't match the frame size contained in the relevant frame
- descriptor. */
+ [Caml_state->bottom_of_stack] to the highest address in the caller's
+ stack frame won't match the frame size contained in the relevant
+ frame descriptor. */
add x29, sp, #16
- STOREGLOBAL(x29, caml_bottom_of_stack)
+ str x29, Caml_state(bottom_of_stack)
add x29, sp, #0
/* Record return address */
- STOREGLOBAL(x30, caml_last_return_address)
+ str x30, Caml_state(last_return_address)
/* Call GC */
bl .Lcaml_call_gc
/* Restore return address */
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
-2: stp x29, x30, [sp, -16]!
+2: add ALLOC_PTR, ALLOC_PTR, #24
+ stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
add x29, sp, #16
- STOREGLOBAL(x29, caml_bottom_of_stack)
+ str x29, Caml_state(bottom_of_stack)
add x29, sp, #0
/* Record return address */
- STOREGLOBAL(x30, caml_last_return_address)
+ str x30, Caml_state(last_return_address)
/* Call GC */
bl .Lcaml_call_gc
/* Restore return address */
.type caml_alloc2, %function
.size caml_alloc2, .-caml_alloc2
- .align 2
- .globl caml_alloc3
-caml_alloc3:
+FUNCTION(caml_alloc3)
CFI_STARTPROC
1: sub ALLOC_PTR, ALLOC_PTR, #32
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
-2: stp x29, x30, [sp, -16]!
+2: add ALLOC_PTR, ALLOC_PTR, #32
+ stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
add x29, sp, #16
- STOREGLOBAL(x29, caml_bottom_of_stack)
+ str x29, Caml_state(bottom_of_stack)
add x29, sp, #0
/* Record return address */
- STOREGLOBAL(x30, caml_last_return_address)
+ str x30, Caml_state(last_return_address)
/* Call GC */
bl .Lcaml_call_gc
/* Restore return address */
.type caml_alloc3, %function
.size caml_alloc3, .-caml_alloc3
+ TEXT_SECTION(caml_allocN)
.align 2
.globl caml_allocN
caml_allocN:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
-2: stp x29, x30, [sp, -16]!
+2: add ALLOC_PTR, ALLOC_PTR, ARG
+ stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
add x29, sp, #16
- STOREGLOBAL(x29, caml_bottom_of_stack)
+ str x29, Caml_state(bottom_of_stack)
add x29, sp, #0
/* Record return address */
- STOREGLOBAL(x30, caml_last_return_address)
+ str x30, Caml_state(last_return_address)
/* Call GC. This preserves ARG */
bl .Lcaml_call_gc
/* Restore return address */
/* Try again */
b 1b
CFI_ENDPROC
- .type caml_allocN, %function
.size caml_allocN, .-caml_allocN
/* Call a C function from OCaml */
/* Function to call is in ARG */
- .align 2
- .globl caml_c_call
-caml_c_call:
+FUNCTION(caml_c_call)
CFI_STARTPROC
/* Preserve return address in callee-save register x19 */
mov x19, x30
CFI_REGISTER(30, 19)
/* Record lowest stack address and return address */
- STOREGLOBAL(x30, caml_last_return_address)
+ str x30, Caml_state(last_return_address)
add TMP, sp, #0
- STOREGLOBAL(TMP, caml_bottom_of_stack)
+ str TMP, Caml_state(bottom_of_stack)
/* Make the exception handler alloc ptr available to the C code */
- STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
- STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
+ str ALLOC_PTR, Caml_state(young_ptr)
+ str TRAP_PTR, Caml_state(exception_pointer)
/* Call the function */
blr ARG
/* Reload alloc ptr and alloc limit */
- LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
- LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
+ ldr ALLOC_PTR, Caml_state(young_ptr)
+ ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Return */
ret x19
CFI_ENDPROC
- .type caml_c_call, %function
.size caml_c_call, .-caml_c_call
/* Start the OCaml program */
- .align 2
- .globl caml_start_program
-caml_start_program:
+FUNCTION(caml_start_program)
CFI_STARTPROC
+ mov ARG_DOMAIN_STATE_PTR, C_ARG_1
ADDRGLOBAL(ARG, caml_program)
/* Code shared with caml_callback* */
stp d10, d11, [sp, 112]
stp d12, d13, [sp, 128]
stp d14, d15, [sp, 144]
+ /* Load domain state pointer from argument */
+ mov DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR
/* Setup a callback link on the stack */
- LOADGLOBAL(x8, caml_bottom_of_stack)
- LOADGLOBAL(x9, caml_last_return_address)
- LOADGLOBAL(x10, caml_gc_regs)
+ ldr x8, Caml_state(bottom_of_stack)
+ ldr x9, Caml_state(last_return_address)
+ ldr x10, Caml_state(gc_regs)
stp x8, x9, [sp, -32]! /* 16-byte alignment */
CFI_ADJUST(32)
str x10, [sp, 16]
/* Setup a trap frame to catch exceptions escaping the OCaml code */
- LOADGLOBAL(x8, caml_exception_pointer)
+ ldr x8, Caml_state(exception_pointer)
adr x9, .Ltrap_handler
stp x8, x9, [sp, -16]!
CFI_ADJUST(16)
add TRAP_PTR, sp, #0
/* Reload allocation pointers */
- LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
- LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
+ ldr ALLOC_PTR, Caml_state(young_ptr)
+ ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Call the OCaml code */
blr ARG
.Lcaml_retaddr:
/* Pop the trap frame, restoring caml_exception_pointer */
ldr x8, [sp], 16
CFI_ADJUST(-16)
- STOREGLOBAL(x8, caml_exception_pointer)
+ str x8, Caml_state(exception_pointer)
/* Pop the callback link, restoring the global variables */
.Lreturn_result:
ldr x10, [sp, 16]
ldp x8, x9, [sp], 32
CFI_ADJUST(-32)
- STOREGLOBAL(x8, caml_bottom_of_stack)
- STOREGLOBAL(x9, caml_last_return_address)
- STOREGLOBAL(x10, caml_gc_regs)
+ str x8, Caml_state(bottom_of_stack)
+ str x9, Caml_state(last_return_address)
+ str x10, Caml_state(gc_regs)
/* Update allocation pointer */
- STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
+ str ALLOC_PTR, Caml_state(young_ptr)
/* Reload callee-save registers and return address */
ldp x19, x20, [sp, 16]
ldp x21, x22, [sp, 32]
CFI_ENDPROC
.type .Lcaml_retaddr, %function
.size .Lcaml_retaddr, .-.Lcaml_retaddr
- .type caml_start_program, %function
.size caml_start_program, .-caml_start_program
/* The trap handler */
.Ltrap_handler:
CFI_STARTPROC
/* Save exception pointer */
- STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
+ str TRAP_PTR, Caml_state(exception_pointer)
/* Encode exception bucket as an exception result */
orr x0, x0, #2
/* Return it */
/* Raise an exception from OCaml */
- .align 2
- .globl caml_raise_exn
-caml_raise_exn:
+FUNCTION(caml_raise_exn)
CFI_STARTPROC
/* Test if backtrace is active */
- LOADGLOBAL32(TMP, caml_backtrace_active)
- cbnz TMP, 2f
+ ldr TMP, Caml_state(backtrace_active)
+ cbnz TMP, 2f
1: /* Cut stack at current trap handler */
mov sp, TRAP_PTR
/* Pop previous handler and jump to it */
mov x0, x19
b 1b
CFI_ENDPROC
- .type caml_raise_exn, %function
.size caml_raise_exn, .-caml_raise_exn
/* Raise an exception from C */
- .align 2
- .globl caml_raise_exception
-caml_raise_exception:
+FUNCTION(caml_raise_exception)
CFI_STARTPROC
+ /* Load the domain state ptr */
+ mov DOMAIN_STATE_PTR, C_ARG_1
+ /* Load the exception bucket */
+ mov x0, C_ARG_2
/* Reload trap ptr, alloc ptr and alloc limit */
- LOADGLOBAL(TRAP_PTR, caml_exception_pointer)
- LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
- LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
+ ldr TRAP_PTR, Caml_state(exception_pointer)
+ ldr ALLOC_PTR, Caml_state(young_ptr)
+ ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Test if backtrace is active */
- LOADGLOBAL32(TMP, caml_backtrace_active)
+ ldr TMP, Caml_state(backtrace_active)
cbnz TMP, 2f
1: /* Cut stack at current trap handler */
mov sp, TRAP_PTR
2: /* Preserve exception bucket in callee-save register x19 */
mov x19, x0
/* Stash the backtrace */
- /* arg1: exn bucket, already in x0 */
- LOADGLOBAL(x1, caml_last_return_address) /* arg2: pc of raise */
- LOADGLOBAL(x2, caml_bottom_of_stack) /* arg3: sp of raise */
+ /* arg1: exn bucket */
+ ldr x1, Caml_state(last_return_address) /* arg2: pc of raise */
+ ldr x2, Caml_state(bottom_of_stack) /* arg3: sp of raise */
mov x3, TRAP_PTR /* arg4: sp of handler */
bl caml_stash_backtrace
/* Restore exception bucket and raise */
mov x0, x19
b 1b
CFI_ENDPROC
- .type caml_raise_exception, %function
.size caml_raise_exception, .-caml_raise_exception
/* Callback from C to OCaml */
- .align 2
- .globl caml_callback_exn
-caml_callback_exn:
+FUNCTION(caml_callback_asm)
CFI_STARTPROC
- /* Initial shuffling of arguments (x0 = closure, x1 = first arg) */
- mov TMP, x0
- mov x0, x1 /* x0 = first arg */
- mov x1, TMP /* x1 = closure environment */
- ldr ARG, [TMP] /* code pointer */
+ /* Initial shuffling of arguments */
+ /* (x0 = Caml_state, x1 = closure, [x2] = first arg) */
+ mov ARG_DOMAIN_STATE_PTR, x0
+ ldr x0, [x2] /* x0 = first arg */
+ /* x1 = closure environment */
+ ldr ARG, [x1] /* code pointer */
b .Ljump_to_caml
CFI_ENDPROC
- .type caml_callback_exn, %function
- .size caml_callback_exn, .-caml_callback_exn
+ .type caml_callback_asm, %function
+ .size caml_callback_asm, .-caml_callback_asm
+ TEXT_SECTION(caml_callback2_asm)
.align 2
- .globl caml_callback2_exn
-caml_callback2_exn:
+ .globl caml_callback2_asm
+caml_callback2_asm:
CFI_STARTPROC
- /* Initial shuffling of arguments (x0 = closure, x1 = arg1, x2 = arg2) */
- mov TMP, x0
- mov x0, x1 /* x0 = first arg */
- mov x1, x2 /* x1 = second arg */
+ /* Initial shuffling of arguments */
+ /* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2) */
+ mov ARG_DOMAIN_STATE_PTR, x0
+ mov TMP, x1
+ ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
mov x2, TMP /* x2 = closure environment */
ADDRGLOBAL(ARG, caml_apply2)
b .Ljump_to_caml
CFI_ENDPROC
- .type caml_callback2_exn, %function
- .size caml_callback2_exn, .-caml_callback2_exn
+ .type caml_callback2_asm, %function
+ .size caml_callback2_asm, .-caml_callback2_asm
+ TEXT_SECTION(caml_callback3_asm)
.align 2
- .globl caml_callback3_exn
-caml_callback3_exn:
+ .globl caml_callback3_asm
+caml_callback3_asm:
CFI_STARTPROC
/* Initial shuffling of arguments */
- /* (x0 = closure, x1 = arg1, x2 = arg2, x3 = arg3) */
- mov TMP, x0
- mov x0, x1 /* x0 = first arg */
- mov x1, x2 /* x1 = second arg */
- mov x2, x3 /* x2 = third arg */
- mov x3, TMP /* x3 = closure environment */
+ /* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2,
+ [x2,16] = arg3) */
+ mov ARG_DOMAIN_STATE_PTR, x0
+ mov x3, x1 /* x3 = closure environment */
+ ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
+ ldr x2, [x2, 16] /* x2 = third arg */
ADDRGLOBAL(ARG, caml_apply3)
b .Ljump_to_caml
CFI_ENDPROC
- .type caml_callback3_exn, %function
- .size caml_callback3_exn, .-caml_callback3_exn
+ .size caml_callback3_asm, .-caml_callback3_asm
- .align 2
- .globl caml_ml_array_bound_error
-caml_ml_array_bound_error:
+FUNCTION(caml_ml_array_bound_error)
CFI_STARTPROC
/* Load address of [caml_array_bound_error] in ARG */
ADDRGLOBAL(ARG, caml_array_bound_error)
/* Call that function */
b caml_c_call
CFI_ENDPROC
- .type caml_ml_array_bound_error, %function
.size caml_ml_array_bound_error, .-caml_ml_array_bound_error
.globl caml_system__code_end
caml_invalid_argument("Float.Array.create");
else {
result = caml_alloc_shr (wosize, Double_array_tag);
- result = caml_check_urgent_gc (result);
}
- return result;
+ // Give the GC a chance to run, and run memprof callbacks
+ return caml_process_pending_actions_with_root (result);
}
/* [len] is a [value] representing number of words or floats */
for (i = 0; i < size; i++) Field(res, i) = init;
}
else if (size > Max_wosize) caml_invalid_argument("Array.make");
- else if (Is_block(init) && Is_young(init)) {
- /* We don't want to create so many major-to-minor references,
- so [init] is moved to the major heap by doing a minor GC. */
- CAML_INSTR_INT ("force_minor/make_vect@", 1);
- caml_request_minor_gc ();
- caml_gc_dispatch ();
- res = caml_alloc_shr(size, 0);
- for (i = 0; i < size; i++) Field(res, i) = init;
- res = caml_check_urgent_gc (res);
- }
else {
+ if (Is_block(init) && Is_young(init)) {
+ /* We don't want to create so many major-to-minor references,
+ so [init] is moved to the major heap by doing a minor GC. */
+ CAML_INSTR_INT ("force_minor/make_vect@", 1);
+ caml_minor_collection ();
+ }
+ CAMLassert(!(Is_block(init) && Is_young(init)));
res = caml_alloc_shr(size, 0);
- for (i = 0; i < size; i++) caml_initialize(&Field(res, i), init);
- res = caml_check_urgent_gc (res);
+ /* We now know that [init] is not in the minor heap, so there is
+ no need to call [caml_initialize]. */
+ for (i = 0; i < size; i++) Field(res, i) = init;
}
}
+ // Give the GC a chance to run, and run memprof callbacks
+ caml_process_pending_actions ();
CAMLreturn (res);
}
res = caml_alloc_small(wsize, Double_array_tag);
} else {
res = caml_alloc_shr(wsize, Double_array_tag);
- res = caml_check_urgent_gc(res);
}
for (i = 0; i < size; i++) {
double d = Double_val(Field(init, i));
Store_double_flat_field(res, i, d);
}
+ // run memprof callbacks
+ caml_process_pending_actions();
CAMLreturn (res);
}
}
CAMLassert(pos == size);
/* Many caml_initialize in a row can create a lot of old-to-young
- refs. Give the minor GC a chance to run if it needs to. */
- res = caml_check_urgent_gc(res);
+ refs. Give the minor GC a chance to run if it needs to.
+ Run memprof callbacks for the major allocation. */
+ res = caml_process_pending_actions_with_root (res);
}
CAMLreturn (res);
}
}
return res;
}
+
+CAMLprim value caml_array_fill(value array,
+ value v_ofs,
+ value v_len,
+ value val)
+{
+ intnat ofs = Long_val(v_ofs);
+ intnat len = Long_val(v_len);
+ value* fp;
+
+ /* This duplicates the logic of caml_modify. Please refer to the
+ implementation of that function for a description of GC
+ invariants we need to enforce.*/
+
+#ifdef FLAT_FLOAT_ARRAY
+ if (Tag_val(array) == Double_array_tag) {
+ double d = Double_val (val);
+ for (; len > 0; len--, ofs++)
+ Store_double_flat_field(array, ofs, d);
+ return Val_unit;
+ }
+#endif
+ fp = &Field(array, ofs);
+ if (Is_young(array)) {
+ for (; len > 0; len--, fp++) *fp = val;
+ } else {
+ int is_val_young_block = Is_block(val) && Is_young(val);
+ CAMLassert(Is_in_heap(fp));
+ for (; len > 0; len--, fp++) {
+ value old = *fp;
+ if (old == val) continue;
+ *fp = val;
+ if (Is_block(old)) {
+ if (Is_young(old)) continue;
+ if (caml_gc_phase == Phase_mark) caml_darken(old, NULL);
+ }
+ if (is_val_young_block)
+ add_to_ref_table (Caml_state->ref_table, fp);
+ }
+ if (is_val_young_block) caml_check_urgent_gc (Val_unit);
+ }
+ return Val_unit;
+}
#include "caml/backtrace.h"
#include "caml/backtrace_prim.h"
#include "caml/fail.h"
-
-CAMLexport int32_t caml_backtrace_active = 0;
-CAMLexport int32_t caml_backtrace_pos = 0;
-CAMLexport backtrace_slot * caml_backtrace_buffer = NULL;
-CAMLexport value caml_backtrace_last_exn = Val_unit;
+#include "caml/debugger.h"
void caml_init_backtrace(void)
{
- caml_register_global_root(&caml_backtrace_last_exn);
+ caml_register_global_root(&Caml_state->backtrace_last_exn);
}
/* Start or stop the backtrace machinery */
{
int flag = Int_val(vflag);
- if (flag != caml_backtrace_active) {
- caml_backtrace_active = flag;
- caml_backtrace_pos = 0;
- caml_backtrace_last_exn = Val_unit;
- /* Note: We do lazy initialization of caml_backtrace_buffer when
+ if (flag != Caml_state->backtrace_active) {
+ Caml_state->backtrace_active = flag;
+ Caml_state->backtrace_pos = 0;
+ Caml_state->backtrace_last_exn = Val_unit;
+ /* Note: We do lazy initialization of Caml_state->backtrace_buffer when
needed in order to simplify the interface with the thread
library (thread creation doesn't need to allocate
- caml_backtrace_buffer). So we don't have to allocate it here.
+ Caml_state->backtrace_buffer). So we don't have to allocate it here.
*/
}
return Val_unit;
/* Return the status of the backtrace machinery */
CAMLprim value caml_backtrace_status(value vunit)
{
- return Val_bool(caml_backtrace_active);
+ return Val_bool(Caml_state->backtrace_active);
}
/* Print location information -- same behavior as in Printexc
return;
}
- for (i = 0; i < caml_backtrace_pos; i++) {
- for (dbg = caml_debuginfo_extract(caml_backtrace_buffer[i]);
+ for (i = 0; i < Caml_state->backtrace_pos; i++) {
+ for (dbg = caml_debuginfo_extract(Caml_state->backtrace_buffer[i]);
dbg != NULL;
dbg = caml_debuginfo_next(dbg))
{
CAMLparam0();
CAMLlocal1(res);
- /* Beware: the allocations below may cause finalizers to be run, and another
- backtrace---possibly of a different length---to be stashed (for example
- if the finalizer raises then catches an exception). We choose to ignore
- any such finalizer backtraces and return the original one. */
-
- if (!caml_backtrace_active ||
- caml_backtrace_buffer == NULL ||
- caml_backtrace_pos == 0) {
+ if (!Caml_state->backtrace_active ||
+ Caml_state->backtrace_buffer == NULL ||
+ Caml_state->backtrace_pos == 0) {
res = caml_alloc(0, 0);
}
else {
- backtrace_slot saved_caml_backtrace_buffer[BACKTRACE_BUFFER_SIZE];
- int saved_caml_backtrace_pos;
- intnat i;
+ intnat i, len = Caml_state->backtrace_pos;
- saved_caml_backtrace_pos = caml_backtrace_pos;
-
- if (saved_caml_backtrace_pos > BACKTRACE_BUFFER_SIZE) {
- saved_caml_backtrace_pos = BACKTRACE_BUFFER_SIZE;
- }
-
- memcpy(saved_caml_backtrace_buffer, caml_backtrace_buffer,
- saved_caml_backtrace_pos * sizeof(backtrace_slot));
-
- res = caml_alloc(saved_caml_backtrace_pos, 0);
- for (i = 0; i < saved_caml_backtrace_pos; i++) {
- Field(res, i) = Val_backtrace_slot(saved_caml_backtrace_buffer[i]);
- }
+ res = caml_alloc(len, 0);
+ for (i = 0; i < len; i++)
+ Field(res, i) = Val_backtrace_slot(Caml_state->backtrace_buffer[i]);
}
CAMLreturn(res);
intnat i;
mlsize_t bt_size;
- caml_backtrace_last_exn = exn;
+ Caml_state->backtrace_last_exn = exn;
bt_size = Wosize_val(backtrace);
if(bt_size > BACKTRACE_BUFFER_SIZE){
/* We don't allocate if the backtrace is empty (no -g or backtrace
not activated) */
if(bt_size == 0){
- caml_backtrace_pos = 0;
+ Caml_state->backtrace_pos = 0;
return Val_unit;
}
/* Allocate if needed and copy the backtrace buffer */
- if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1){
+ if (Caml_state->backtrace_buffer == NULL &&
+ caml_alloc_backtrace_buffer() == -1) {
return Val_unit;
}
- caml_backtrace_pos = bt_size;
- for(i=0; i < caml_backtrace_pos; i++){
- caml_backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i));
+ Caml_state->backtrace_pos = bt_size;
+ for(i=0; i < Caml_state->backtrace_pos; i++){
+ Caml_state->backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i));
}
return Val_unit;
CAMLreturn(res);
}
+
+CAMLprim value caml_get_current_callstack(value max_frames_value) {
+ CAMLparam1(max_frames_value);
+ CAMLlocal1(res);
+
+ res = caml_alloc(caml_current_callstack_size(Long_val(max_frames_value)), 0);
+ caml_current_callstack_write(res);
+
+ CAMLreturn(res);
+}
#include "caml/backtrace.h"
#include "caml/fail.h"
#include "caml/backtrace_prim.h"
+#include "caml/debugger.h"
/* The table of debug information fragments */
struct ext_table caml_debug_info;
CAMLparam1(events_heap);
struct debug_info *debug_info;
+ if (events_heap != Val_unit)
+ caml_debugger(DEBUG_INFO_ADDED, events_heap);
+
/* build the OCaml-side debug_info value */
debug_info = caml_stat_alloc(sizeof(struct debug_info));
}
int caml_alloc_backtrace_buffer(void){
- CAMLassert(caml_backtrace_pos == 0);
- caml_backtrace_buffer =
+ CAMLassert(Caml_state->backtrace_pos == 0);
+ Caml_state->backtrace_buffer =
caml_stat_alloc_noexc(BACKTRACE_BUFFER_SIZE * sizeof(code_t));
- if (caml_backtrace_buffer == NULL) return -1;
+ if (Caml_state->backtrace_buffer == NULL) return -1;
return 0;
}
/* Store the return addresses contained in the given stack fragment
into the backtrace array */
-void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise)
+void caml_stash_backtrace(value exn, value * sp, int reraise)
{
- if (pc != NULL) pc = pc - 1;
- if (exn != caml_backtrace_last_exn || !reraise) {
- caml_backtrace_pos = 0;
- caml_backtrace_last_exn = exn;
+ if (exn != Caml_state->backtrace_last_exn || !reraise) {
+ Caml_state->backtrace_pos = 0;
+ Caml_state->backtrace_last_exn = exn;
}
- if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1)
+ if (Caml_state->backtrace_buffer == NULL &&
+ caml_alloc_backtrace_buffer() == -1)
return;
- if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return;
- /* testing the code region is needed: PR#8026 */
- if (find_debug_info(pc) != NULL)
- caml_backtrace_buffer[caml_backtrace_pos++] = pc;
-
/* Traverse the stack and put all values pointing into bytecode
into the backtrace buffer. */
- for (/*nothing*/; sp < caml_trapsp; sp++) {
- code_t p = (code_t) *sp;
- if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) break;
+ for (/*nothing*/; sp < Caml_state->trapsp; sp++) {
+ code_t p;
+ if (Is_long(*sp)) continue;
+ p = (code_t) *sp;
+ if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) break;
if (find_debug_info(p) != NULL)
- caml_backtrace_buffer[caml_backtrace_pos++] = p;
+ Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] = p;
}
}
code_t caml_next_frame_pointer(value ** sp, value ** trsp)
{
- while (*sp < caml_stack_high) {
- code_t *p = (code_t*) (*sp)++;
+ while (*sp < Caml_state->stack_high) {
+ value *spv = (*sp)++;
+ code_t *p;
+ if (Is_long(*spv)) continue;
+ p = (code_t*) spv;
if(&Trap_pc(*trsp) == p) {
*trsp = Trap_link(*trsp);
continue;
return NULL;
}
-/* Stores upto [max_frames_value] frames of the current call stack to
- return to the user. This is used not in an exception-raising
- context, but only when the user requests to save the trace
- (hopefully less often). Instead of using a bounded buffer as
- [caml_stash_backtrace], we first traverse the stack to compute the
- right size, then allocate space for the trace. */
-
-CAMLprim value caml_get_current_callstack(value max_frames_value)
+intnat caml_current_callstack_size(intnat max_frames)
{
- CAMLparam1(max_frames_value);
- CAMLlocal1(trace);
-
- /* we use `intnat` here because, were it only `int`, passing `max_int`
- from the OCaml side would overflow on 64bits machines. */
- intnat max_frames = Long_val(max_frames_value);
intnat trace_size;
+ value * sp = Caml_state->extern_sp;
+ value * trsp = Caml_state->trapsp;
- /* first compute the size of the trace */
- {
- value * sp = caml_extern_sp;
- value * trsp = caml_trapsp;
-
- for (trace_size = 0; trace_size < max_frames; trace_size++) {
- code_t p = caml_next_frame_pointer(&sp, &trsp);
- if (p == NULL) break;
- }
+ for (trace_size = 0; trace_size < max_frames; trace_size++) {
+ code_t p = caml_next_frame_pointer(&sp, &trsp);
+ if (p == NULL) break;
}
- trace = caml_alloc(trace_size, 0);
-
- /* then collect the trace */
- {
- value * sp = caml_extern_sp;
- value * trsp = caml_trapsp;
- uintnat trace_pos;
+ return trace_size;
+}
- for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
- code_t p = caml_next_frame_pointer(&sp, &trsp);
- CAMLassert(p != NULL);
- Field(trace, trace_pos) = Val_backtrace_slot(p);
- }
+void caml_current_callstack_write(value trace) {
+ value * sp = Caml_state->extern_sp;
+ value * trsp = Caml_state->trapsp;
+ uintnat trace_pos, trace_size = Wosize_val(trace);
+
+ for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
+ code_t p = caml_next_frame_pointer(&sp, &trsp);
+ CAMLassert(p != NULL);
+ /* [Val_backtrace_slot(...)] is always a long, no need to call
+ [caml_modify]. */
+ Field(trace, trace_pos) = Val_backtrace_slot(p);
}
-
- CAMLreturn(trace);
}
/* Read the debugging info contained in the current bytecode executable. */
}
int caml_alloc_backtrace_buffer(void){
- CAMLassert(caml_backtrace_pos == 0);
- caml_backtrace_buffer =
+ CAMLassert(Caml_state->backtrace_pos == 0);
+ Caml_state->backtrace_buffer =
caml_stat_alloc_noexc(BACKTRACE_BUFFER_SIZE * sizeof(backtrace_slot));
- if (caml_backtrace_buffer == NULL) return -1;
+ if (Caml_state->backtrace_buffer == NULL) return -1;
return 0;
}
[caml_get_current_callstack] was implemented. */
void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp)
{
- if (exn != caml_backtrace_last_exn) {
- caml_backtrace_pos = 0;
- caml_backtrace_last_exn = exn;
+ if (exn != Caml_state->backtrace_last_exn) {
+ Caml_state->backtrace_pos = 0;
+ Caml_state->backtrace_last_exn = exn;
}
- if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1)
+ if (Caml_state->backtrace_buffer == NULL &&
+ caml_alloc_backtrace_buffer() == -1)
return;
/* iterate on each frame */
frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
if (descr == NULL) return;
/* store its descriptor in the backtrace buffer */
- if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return;
- caml_backtrace_buffer[caml_backtrace_pos++] = (backtrace_slot) descr;
+ if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) return;
+ Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] =
+ (backtrace_slot) descr;
/* Stop when we reach the current exception handler */
if (sp > trapsp) return;
}
}
-/* Stores upto [max_frames_value] frames of the current call stack to
- return to the user. This is used not in an exception-raising
- context, but only when the user requests to save the trace
- (hopefully less often). Instead of using a bounded buffer as
- [caml_stash_backtrace], we first traverse the stack to compute the
- right size, then allocate space for the trace. */
-CAMLprim value caml_get_current_callstack(value max_frames_value)
-{
- CAMLparam1(max_frames_value);
- CAMLlocal1(trace);
-
- /* we use `intnat` here because, were it only `int`, passing `max_int`
- from the OCaml side would overflow on 64bits machines. */
- intnat max_frames = Long_val(max_frames_value);
- intnat trace_size;
-
- /* first compute the size of the trace */
- {
- uintnat pc = caml_last_return_address;
- char * sp = caml_bottom_of_stack;
- char * limitsp = caml_top_of_stack;
+intnat caml_current_callstack_size(intnat max_frames) {
+ intnat trace_size = 0;
+ uintnat pc = Caml_state->last_return_address;
+ char * sp = Caml_state->bottom_of_stack;
- trace_size = 0;
- while (1) {
- frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
- if (descr == NULL) break;
- if (trace_size >= max_frames) break;
- ++trace_size;
+ while (1) {
+ frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
+ if (descr == NULL) break;
+ if (trace_size >= max_frames) break;
+ ++trace_size;
- if (sp > limitsp) break;
- }
+ if (sp > Caml_state->top_of_stack) break;
}
- trace = caml_alloc((mlsize_t) trace_size, 0);
+ return trace_size;
+}
- /* then collect the trace */
- {
- uintnat pc = caml_last_return_address;
- char * sp = caml_bottom_of_stack;
- intnat trace_pos;
+void caml_current_callstack_write(value trace) {
+ uintnat pc = Caml_state->last_return_address;
+ char * sp = Caml_state->bottom_of_stack;
+ intnat trace_pos, trace_size = Wosize_val(trace);
- for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
- frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
- CAMLassert(descr != NULL);
- Field(trace, trace_pos) = Val_backtrace_slot((backtrace_slot) descr);
- }
+ for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
+ frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
+ CAMLassert(descr != NULL);
+ /* [Val_backtrace_slot(...)] is always a long, no need to call
+ [caml_modify]. */
+ Field(trace, trace_pos) = Val_backtrace_slot((backtrace_slot) descr);
}
-
- CAMLreturn(trace);
}
-
debuginfo caml_debuginfo_extract(backtrace_slot slot)
{
uintnat infoptr;
if (e1 < e2) return -1; \
if (e1 > e2) return 1; \
if (e1 != e2) { \
- caml_compare_unordered = 1; \
+ Caml_state->compare_unordered = 1; \
if (e1 == e1) return 1; \
if (e2 == e2) return -1; \
} \
#include <string.h>
#include "caml/callback.h"
+#include "caml/domain.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include "caml/mlvalues.h"
CAMLassert(narg + 4 <= 256);
- caml_extern_sp -= narg + 4;
- for (i = 0; i < narg; i++) caml_extern_sp[i] = args[i]; /* arguments */
+ Caml_state->extern_sp -= narg + 4;
+ for (i = 0; i < narg; i++) Caml_state->extern_sp[i] = args[i]; /* arguments */
#ifndef LOCAL_CALLBACK_BYTECODE
- caml_extern_sp[narg] = (value) (callback_code + 4); /* return address */
- caml_extern_sp[narg + 1] = Val_unit; /* environment */
- caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
- caml_extern_sp[narg + 3] = closure;
+ Caml_state->extern_sp[narg] = (value)(callback_code + 4); /* return address */
+ Caml_state->extern_sp[narg + 1] = Val_unit; /* environment */
+ Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */
+ Caml_state->extern_sp[narg + 3] = closure;
Init_callback();
callback_code[1] = narg + 3;
callback_code[3] = narg;
res = caml_interprete(callback_code, sizeof(callback_code));
#else /*have LOCAL_CALLBACK_BYTECODE*/
- caml_extern_sp[narg] = (value) (local_callback_code + 4); /* return address */
- caml_extern_sp[narg + 1] = Val_unit; /* environment */
- caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
- caml_extern_sp[narg + 3] = closure;
+ /* return address */
+ Caml_state->extern_sp[narg] = (value) (local_callback_code + 4);
+ Caml_state->extern_sp[narg + 1] = Val_unit; /* environment */
+ Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */
+ Caml_state->extern_sp[narg + 3] = closure;
local_callback_code[0] = ACC;
local_callback_code[1] = narg + 3;
local_callback_code[2] = APPLY;
res = caml_interprete(local_callback_code, sizeof(local_callback_code));
caml_release_bytecode(local_callback_code, sizeof(local_callback_code));
#endif /*LOCAL_CALLBACK_BYTECODE*/
- if (Is_exception_result(res)) caml_extern_sp += narg + 4; /* PR#3419 */
+ if (Is_exception_result(res)) Caml_state->extern_sp += narg + 4; /* PR#3419 */
return res;
}
#else
-/* Native-code callbacks. caml_callback[123]_exn are implemented in asm. */
+/* Native-code callbacks. */
+
+typedef value (callback_stub)(caml_domain_state* state, value closure,
+ value* args);
+
+callback_stub caml_callback_asm, caml_callback2_asm, caml_callback3_asm;
+
+CAMLexport value caml_callback_exn(value closure, value arg)
+{
+ return caml_callback_asm(Caml_state, closure, &arg);
+}
+
+CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
+{
+ value args[] = {arg1, arg2};
+ return caml_callback2_asm(Caml_state, closure, args);
+}
+
+CAMLexport value caml_callback3_exn(value closure,
+ value arg1, value arg2, value arg3)
+{
+ value args[] = {arg1, arg2, arg3};
+ return caml_callback3_asm(Caml_state, closure, args);
+}
+
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
{
CAMLexport value caml_callback (value closure, value arg)
{
- value res = caml_callback_exn(closure, arg);
- if (Is_exception_result(res)) caml_raise(Extract_exception(res));
- return res;
+ return caml_raise_if_exception(caml_callback_exn(closure, arg));
}
CAMLexport value caml_callback2 (value closure, value arg1, value arg2)
{
- value res = caml_callback2_exn(closure, arg1, arg2);
- if (Is_exception_result(res)) caml_raise(Extract_exception(res));
- return res;
+ return caml_raise_if_exception(caml_callback2_exn(closure, arg1, arg2));
}
CAMLexport value caml_callback3 (value closure, value arg1, value arg2,
value arg3)
{
- value res = caml_callback3_exn(closure, arg1, arg2, arg3);
- if (Is_exception_result(res)) caml_raise(Extract_exception(res));
- return res;
+ return caml_raise_if_exception(caml_callback3_exn(closure, arg1, arg2, arg3));
}
CAMLexport value caml_callbackN (value closure, int narg, value args[])
{
- value res = caml_callbackN_exn(closure, narg, args);
- if (Is_exception_result(res)) caml_raise(Extract_exception(res));
- return res;
+ return caml_raise_if_exception(caml_callbackN_exn(closure, narg, args));
}
/* Naming of OCaml values */
#define Is_young(val) \
(CAMLassert (Is_block (val)), \
- (addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start)
+ (char *)(val) < (char *)Caml_state_field(young_end) && \
+ (char *)(val) > (char *)Caml_state_field(young_start))
#define Is_in_heap(a) (Classify_addr(a) & In_heap)
/***********************************************************************/
/* The rest of this file is private and may change without notice. */
-extern value *caml_young_start, *caml_young_end;
extern char * caml_code_area_start, * caml_code_area_end;
#define Not_in_heap 0
extern "C" {
#endif
+/* It is guaranteed that these allocation functions will not trigger
+ any OCaml callback such as finalizers or signal handlers. */
+
CAMLextern value caml_alloc (mlsize_t wosize, tag_t);
CAMLextern value caml_alloc_small (mlsize_t wosize, tag_t);
CAMLextern value caml_alloc_tuple (mlsize_t wosize);
*
* Backtrace generation is split in multiple steps.
* The lowest-level one, done by [backtrace_byt.c] and
- * [backtrace_nat.c] just fills the [caml_backtrace_buffer]
+ * [backtrace_nat.c] just fills the [Caml_state->backtrace_buffer]
* variable each time a frame is unwinded.
* At that point, we don't know whether the backtrace will be useful or not so
* this code should be as fast as possible.
*
* If the backtrace happens to be useful, later passes will read
- * [caml_backtrace_buffer] and turn it into a [raw_backtrace] and then a
+ * [Caml_state->backtrace_buffer] and turn it into a [raw_backtrace] and then a
* [backtrace].
* This is done in [backtrace.c] and [stdlib/printexc.ml].
*
* Content of buffers
* ------------------
*
- * [caml_backtrace_buffer] (really cheap)
+ * [Caml_state->backtrace_buffer] (really cheap)
* Backend and process image dependent, abstracted by C-type backtrace_slot.
* [raw_backtrace] (cheap)
* OCaml values of abstract type [Printexc.raw_backtrace_slot],
* [backtrace] (more expensive)
* OCaml values of algebraic data-type [Printexc.backtrace_slot]
*/
-
-/* Non zero iff backtraces are recorded.
- * One should use to change this variable [caml_record_backtrace].
- */
-CAMLextern int caml_backtrace_active;
-
-/* The [backtrace_slot] type represents values stored in the
- * [caml_backtrace_buffer]. In bytecode, it is the same as a
- * [code_t], in native code it as a [frame_descr *]. The difference
- * doesn't matter for code outside [backtrace_{byt,nat}.c],
- * so it is just exposed as a [backtrace_slot].
+ /* [Caml_state->backtrace_active] is non zero iff backtraces are recorded.
+ * This variable must be changed with [caml_record_backtrace].
*/
-typedef void * backtrace_slot;
-
-/* The [caml_backtrace_buffer] and [caml_backtrace_last_exn]
- * variables are valid only if [caml_backtrace_active != 0].
+#define caml_backtrace_active (Caml_state_field(backtrace_active))
+/* The [Caml_state->backtrace_buffer] and [Caml_state->backtrace_last_exn]
+ * variables are valid only if [Caml_state->backtrace_active != 0].
*
* They are part of the state specific to each thread, and threading libraries
* are responsible for copying them on context switch.
- * See [otherlibs/systhreads/st_stubs.c] and [otherlibs/threads/scheduler.c].
- */
-
-/* [caml_backtrace_buffer] is filled by runtime when unwinding stack.
- * It is an array ranging from [0] to [caml_backtrace_pos - 1].
- * [caml_backtrace_pos] is always zero if [!caml_backtrace_active].
+ * See [otherlibs/systhreads/st_stubs.c].
+ *
+ *
+ * [Caml_state->backtrace_buffer] is filled by runtime when unwinding stack. It
+ * is an array ranging from [0] to [Caml_state->backtrace_pos - 1].
+ * [Caml_state->backtrace_pos] is always zero if
+ * [!Caml_state->backtrace_active].
*
* Its maximum size is determined by [BACKTRACE_BUFFER_SIZE] from
* [backtrace_prim.h], but this shouldn't affect users.
*/
-CAMLextern backtrace_slot * caml_backtrace_buffer;
-CAMLextern int caml_backtrace_pos;
+#define caml_backtrace_buffer (Caml_state_field(backtrace_buffer))
+#define caml_backtrace_pos (Caml_state_field(backtrace_pos))
-/* [caml_backtrace_last_exn] stores the last exception value that was raised,
- * iff [caml_backtrace_active != 0].
- * It is tested for equality to determine whether a raise is a re-raise of the
- * same exception.
- *
- * FIXME: this shouldn't matter anymore. Since OCaml 4.02, non-parameterized
+/* [Caml_state->backtrace_last_exn] stores the last exception value that was
+ * raised, iff [Caml_state->backtrace_active != 0]. It is tested for equality
+ * to determine whether a raise is a re-raise of the same exception.
+ */
+#define caml_backtrace_last_exn (Caml_state_field(backtrace_last_exn))
+
+/* FIXME: this shouldn't matter anymore. Since OCaml 4.02, non-parameterized
* exceptions are constant, so physical equality is no longer appropriate.
* raise and re-raise are distinguished by:
* - passing reraise = 1 to [caml_stash_backtrace] (see below) in the bytecode
* interpreter;
- * - directly resetting [caml_backtrace_pos] to 0 in native runtimes for raise.
+ * - directly resetting [Caml_state->backtrace_pos] to 0 in native
+ runtimes for raise.
*/
-CAMLextern value caml_backtrace_last_exn;
/* [caml_record_backtrace] toggle backtrace recording on and off.
* This function can be called at runtime by user-code, or during
/* Primitive called _only_ by runtime to record unwinded frames to
* backtrace. A similar primitive exists for native code, but with a
* different prototype. */
-extern void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise);
+extern void caml_stash_backtrace(value exn, value * sp, int reraise);
#endif
#define Val_backtrace_slot(bslot) (Val_long(((uintnat)(bslot))>>1))
#define Backtrace_slot_val(vslot) ((backtrace_slot)(Long_val(vslot) << 1))
-/* Allocate the caml_backtrace_buffer. Returns 0 on success, -1 otherwise */
+/* Allocate Caml_state->backtrace_buffer. Returns 0 on success, -1 otherwise */
int caml_alloc_backtrace_buffer(void);
#ifndef NATIVE_CODE
* It defines the [caml_stash_backtrace] function, which is called to quickly
* fill the backtrace buffer by walking the stack when an exception is raised.
*
- * It also defines the [caml_get_current_callstack] OCaml primitive, which also
- * walks the stack but directly turns it into a [raw_backtrace] and is called
- * explicitly.
- */
+ * It also defines the two following functions, which makes it possible
+ * to store upto [max_frames_value] frames of the current call
+ * stack. This is not used in an exception-raising context, but only
+ * when the user requests to save the trace (hopefully less often), or
+ * the context of profiling. Instead of using a bounded buffer as
+ * [caml_stash_backtrace], we first traverse the stack to compute the
+ * right size, then allocate space for the trace.
+ *
+ * The first function, [caml_current_callstack_size] computes the size
+ * (in words) of the needed buffer, while the second actually writes
+ * the call stack to the buffer as an object of type
+ * [raw_backtrace]. It should always be called with a buffer of the
+ * size predicted by [caml_current_callstack_size]. The reason we use
+ * two separated functions is to allow using either [caml_alloc] (for
+ * performance) or [caml_alloc_shr] (when we need to avoid a call to
+ * the GC, in memprof.c).
+ *
+ * We use `intnat` for max_frames because, were it only `int`, passing
+ * `max_int` from the OCaml side would overflow on 64bits machines. */
+
+intnat caml_current_callstack_size(intnat max_frames);
+void caml_current_callstack_write(value trace);
#endif /* CAML_INTERNALS */
value arg1, value arg2, value arg3);
CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]);
-#define Make_exception_result(v) ((v) | 2)
-#define Is_exception_result(v) (((v) & 3) == 2)
-#define Extract_exception(v) ((v) & ~3)
-
CAMLextern const value * caml_named_value (char const * name);
typedef void (*caml_named_action) (const value*, char *);
CAMLextern void caml_iterate_named_values(caml_named_action f);
#include "misc.h"
#include "mlvalues.h"
-void caml_compact_heap (void);
+/* [caml_compact_heap] compacts the heap and optionally changes the
+ allocation policy.
+ if [new_allocation_policy] is -1, the policy is not changed.
+*/
+void caml_compact_heap (intnat new_allocation_policy);
+
void caml_compact_heap_maybe (void);
void caml_invert_root (value v, value *p);
#define enter_blocking_section_hook caml_enter_blocking_section_hook
#define leave_blocking_section_hook caml_leave_blocking_section_hook
#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook
-#define async_action_hook caml_async_action_hook
#define enter_blocking_section caml_enter_blocking_section
#define leave_blocking_section caml_leave_blocking_section
#define convert_signal_number caml_convert_signal_number
#include "compatibility.h"
#endif
+#ifndef CAML_CONFIG_H_NO_TYPEDEFS
+
#include <stddef.h>
#if defined(HAS_LOCALE_H) || defined(HAS_XLOCALE_H)
#error "No integer type available to represent pointers"
#endif
+#endif /* CAML_CONFIG_H_NO_TYPEDEFS */
+
/* Endianness of floats */
/* ARCH_FLOAT_ENDIANNESS encodes the byte order of doubles as follows:
CAMLextern void caml_register_custom_operations(struct custom_operations * ops);
-CAMLextern int caml_compare_unordered;
- /* Used by custom comparison to report unordered NaN-like cases. */
+/* Global variable moved to Caml_state in 4.10 */
+#define caml_compare_unordered (Caml_state_field(compare_unordered))
#ifdef CAML_INTERNALS
extern struct custom_operations * caml_find_custom_operations(char * ident);
enum event_kind {
EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
- TRAP_BARRIER, UNCAUGHT_EXC
+ TRAP_BARRIER, UNCAUGHT_EXC, DEBUG_INFO_ADDED,
+ CODE_LOADED, CODE_UNLOADED
};
void caml_debugger_init (void);
-void caml_debugger (enum event_kind event);
+void caml_debugger (enum event_kind event, value param);
void caml_debugger_cleanup_fork (void);
+opcode_t caml_debugger_saved_instruction(code_t pc);
+
/* Communication protocol */
/* Requests from the debugger to the runtime system */
/* Replies to a REQ_GO request. All replies are followed by three uint32_t:
- the value of the event counter
- the position of the stack
- - the current pc. */
+ - the current pc.
+ The REP_CODE_DEBUG_INFO reply is also followed by:
+ - the newly added debug information.
+ The REP_CODE_{UN,}LOADED reply is also followed by:
+ - the code fragment index. */
enum debugger_reply {
REP_EVENT = 'e',
/* Program exited by calling exit or reaching the end of the source. */
REP_TRAP = 's',
/* Trap barrier crossed. */
- REP_UNCAUGHT_EXC = 'u'
+ REP_UNCAUGHT_EXC = 'u',
/* Program exited due to a stray exception. */
+ REP_CODE_DEBUG_INFO = 'D',
+ /* Additional debug info loaded. */
+ REP_CODE_LOADED = 'L',
+ /* Additional code loaded. */
+ REP_CODE_UNLOADED = 'U',
+ /* Additional code unloaded. */
};
#endif /* CAML_INTERNALS */
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#ifndef CAML_DOMAIN_H
+#define CAML_DOMAIN_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef CAML_INTERNALS
+
+#include "domain_state.h"
+
+void caml_init_domain(void);
+
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_DOMAIN_H */
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#ifndef CAML_STATE_H
+#define CAML_STATE_H
+
+#include <stddef.h>
+#include "misc.h"
+#include "mlvalues.h"
+
+/* This structure sits in the TLS area and is also accessed efficiently
+ * via native code, which is why the indices are important */
+
+typedef struct {
+#ifdef CAML_NAME_SPACE
+#define DOMAIN_STATE(type, name) CAMLalign(8) type name;
+#else
+#define DOMAIN_STATE(type, name) CAMLalign(8) type _##name;
+#endif
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+} caml_domain_state;
+
+enum {
+ Domain_state_num_fields =
+#define DOMAIN_STATE(type, name) + 1
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+};
+
+/* Check that the structure was laid out without padding,
+ since the runtime assumes this in computing offsets */
+CAML_STATIC_ASSERT(
+ sizeof(caml_domain_state) ==
+ (Domain_state_num_fields
+ ) * 8);
+
+CAMLextern caml_domain_state* Caml_state;
+#ifdef CAML_NAME_SPACE
+#define Caml_state_field(field) Caml_state->field
+#else
+#define Caml_state_field(field) Caml_state->_##field
+#endif
+
+#endif /* CAML_STATE_H */
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+DOMAIN_STATE(value*, young_ptr)
+DOMAIN_STATE(value*, young_limit)
+/* Minor heap limit. See minor_gc.c. */
+
+DOMAIN_STATE(char*, exception_pointer)
+/* Exception pointer that points into the current stack */
+
+DOMAIN_STATE(void*, young_base)
+DOMAIN_STATE(value*, young_start)
+DOMAIN_STATE(value*, young_end)
+DOMAIN_STATE(value*, young_alloc_start)
+DOMAIN_STATE(value*, young_alloc_end)
+DOMAIN_STATE(value*, young_alloc_mid)
+DOMAIN_STATE(value*, young_trigger)
+DOMAIN_STATE(asize_t, minor_heap_wsz)
+DOMAIN_STATE(intnat, in_minor_collection)
+DOMAIN_STATE(double, extra_heap_resources_minor)
+DOMAIN_STATE(struct caml_ref_table*, ref_table)
+DOMAIN_STATE(struct caml_ephe_ref_table*, ephe_ref_table)
+DOMAIN_STATE(struct caml_custom_table*, custom_table)
+/* See minor_gc.c */
+
+DOMAIN_STATE(value*, stack_low)
+DOMAIN_STATE(value*, stack_high)
+DOMAIN_STATE(value*, stack_threshold)
+DOMAIN_STATE(value*, extern_sp)
+DOMAIN_STATE(value*, trapsp)
+DOMAIN_STATE(value*, trap_barrier)
+DOMAIN_STATE(struct longjmp_buffer*, external_raise)
+DOMAIN_STATE(value, exn_bucket)
+/* See interp.c */
+
+DOMAIN_STATE(char*, top_of_stack)
+DOMAIN_STATE(char*, bottom_of_stack)
+DOMAIN_STATE(uintnat, last_return_address)
+DOMAIN_STATE(value*, gc_regs)
+/* See roots_nat.c */
+
+DOMAIN_STATE(intnat, backtrace_active)
+DOMAIN_STATE(intnat, backtrace_pos)
+DOMAIN_STATE(backtrace_slot*, backtrace_buffer)
+DOMAIN_STATE(value, backtrace_last_exn)
+/* See backtrace.c */
+
+DOMAIN_STATE(intnat, compare_unordered)
+DOMAIN_STATE(intnat, requested_major_slice)
+DOMAIN_STATE(intnat, requested_minor_gc)
+DOMAIN_STATE(struct caml__roots_block *, local_roots)
+
+DOMAIN_STATE(double, stat_minor_words)
+DOMAIN_STATE(double, stat_promoted_words)
+DOMAIN_STATE(double, stat_major_words)
+DOMAIN_STATE(intnat, stat_minor_collections)
+DOMAIN_STATE(intnat, stat_major_collections)
+DOMAIN_STATE(intnat, stat_heap_wsz)
+DOMAIN_STATE(intnat, stat_top_heap_wsz)
+DOMAIN_STATE(intnat, stat_compactions)
+DOMAIN_STATE(intnat, stat_heap_chunks)
+/* See gc_ctrl.c */
/* Magic number for this release */
-#define EXEC_MAGIC "Caml1999X026"
+#define EXEC_MAGIC "Caml1999X027"
#endif /* CAML_INTERNALS */
#define siglongjmp(buf,val) longjmp(buf,val)
#endif
-CAMLextern struct longjmp_buffer * caml_external_raise;
-extern value caml_exn_bucket;
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_external_raise (Caml_state_field(external_raise))
+#define caml_exn_bucket (Caml_state_field(exn_bucket))
+
int caml_is_special_exception(value exn);
+value caml_raise_if_exception(value res);
+
#endif /* CAML_INTERNALS */
#ifdef __cplusplus
void caml_final_update_mark_phase (void);
void caml_final_update_clean_phase (void);
-void caml_final_do_calls (void);
+value caml_final_do_calls_exn (void);
void caml_final_do_roots (scanning_action f);
void caml_final_invert_finalisable_values (void);
void caml_final_oldify_young_roots (void);
extern code_t caml_start_code;
extern asize_t caml_code_size;
-extern unsigned char * caml_saved_code;
void caml_init_code_fragments(void);
void caml_load_code (int fd, asize_t len);
extern asize_t caml_fl_cur_wsz;
-header_t *caml_fl_allocate (mlsize_t wo_sz);
-void caml_fl_init_merge (void);
-void caml_fl_reset (void);
-header_t *caml_fl_merge_block (value);
-void caml_fl_add_blocks (value);
-void caml_make_free_blocks (value *, mlsize_t wsz, int, int);
-void caml_set_allocation_policy (uintnat);
+/* See [freelist.c] for usage info on these functions. */
+extern header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz);
+extern void (*caml_fl_p_init_merge) (void);
+extern void (*caml_fl_p_reset) (void);
+extern header_t *(*caml_fl_p_merge_block) (value bp, char *limit);
+extern void (*caml_fl_p_add_blocks) (value bp);
+extern void (*caml_fl_p_make_free_blocks)
+ (value *p, mlsize_t size, int do_merge, int color);
+#ifdef DEBUG
+extern void (*caml_fl_p_check) (void);
+#endif
+
+static inline header_t *caml_fl_allocate (mlsize_t wo_sz)
+ { return (*caml_fl_p_allocate) (wo_sz); }
+
+static inline void caml_fl_init_merge (void)
+ { (*caml_fl_p_init_merge) (); }
+
+static inline void caml_fl_reset (void)
+ { (*caml_fl_p_reset) (); }
+
+static inline header_t *caml_fl_merge_block (value bp, char *limit)
+ { return (*caml_fl_p_merge_block) (bp, limit); }
+
+static inline void caml_fl_add_blocks (value bp)
+ { (*caml_fl_p_add_blocks) (bp); }
+
+static inline void caml_make_free_blocks
+ (value *p, mlsize_t size, int do_merge, int color)
+ { (*caml_fl_p_make_free_blocks) (p, size, do_merge, color); }
+
+extern void caml_set_allocation_policy (intnat);
+
+#ifdef DEBUG
+static inline void caml_fl_check (void)
+ { (*caml_fl_p_check) (); }
+#endif
#endif /* CAML_INTERNALS */
#include "misc.h"
-extern double
- caml_stat_minor_words,
- caml_stat_promoted_words,
- caml_stat_major_words;
-
-extern intnat
- caml_stat_minor_collections,
- caml_stat_major_collections,
- caml_stat_heap_wsz,
- caml_stat_top_heap_wsz,
- caml_stat_compactions,
- caml_stat_heap_chunks;
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_stat_minor_words (Caml_state_field(stat_minor_words))
+#define caml_stat_promoted_words (Caml_state_field(stat_promoted_words))
+#define caml_stat_major_words (Caml_state_field(stat_major_words))
+#define caml_stat_minor_collections (Caml_state_field(stat_minor_collections))
+#define caml_stat_major_collections (Caml_state_field(stat_major_collections))
+#define caml_stat_heap_wsz (Caml_state_field(stat_heap_wsz))
+#define caml_stat_top_heap_wsz (Caml_state_field(stat_top_heap_wsz))
+#define caml_stat_compactions (Caml_state_field(stat_compactions))
+#define caml_stat_heap_chunks (Caml_state_field(stat_heap_chunks))
/*
minor_size: cf. minor_heap_size in gc.mli
CAMLextern void caml_deserialize_error(char * msg)
CAMLnoreturn_end;
-
-#ifdef CAML_INTERNALS
-
-/* Auxiliary stuff for sending code pointers */
-
-struct code_fragment {
- char * code_start;
- char * code_end;
- unsigned char digest[16];
- char digest_computed;
-};
-
-CAMLextern struct code_fragment * caml_extern_find_code(char *addr);
-
-extern struct ext_table caml_code_fragments_table;
-
-#endif /* CAML_INTERNALS */
-
#ifdef __cplusplus
}
#endif
#undef CAML_SAFE_STRING
#undef FLAT_FLOAT_ARRAY
+
+#undef FUNCTION_SECTIONS
+
+#undef SUPPORTS_ALIGNED_ATTRIBUTE
extern double caml_gc_clock;
/* [caml_major_gc_hook] is called just between the end of the mark
- phase and the beginning of the sweep phase of the major GC */
+ phase and the beginning of the sweep phase of the major GC.
+
+ This hook must not allocate, change any heap value, nor
+ call OCaml code. */
CAMLextern void (*caml_major_gc_hook)(void);
void caml_init_major_heap (asize_t); /* size in bytes */
#endif /* CAML_INTERNALS */
#include "misc.h"
#include "mlvalues.h"
+#include "domain.h"
#ifdef __cplusplus
extern "C" {
#endif
-
CAMLextern value caml_alloc_shr (mlsize_t wosize, tag_t);
#ifdef WITH_PROFINFO
CAMLextern value caml_alloc_shr_with_profinfo (mlsize_t, tag_t, intnat);
-CAMLextern value caml_alloc_shr_preserving_profinfo (mlsize_t, tag_t,
- header_t);
#else
#define caml_alloc_shr_with_profinfo(size, tag, profinfo) \
caml_alloc_shr(size, tag)
-#define caml_alloc_shr_preserving_profinfo(size, tag, header) \
- caml_alloc_shr(size, tag)
#endif /* WITH_PROFINFO */
-CAMLextern value caml_alloc_shr_no_raise (mlsize_t wosize, tag_t);
+
+/* Variant of [caml_alloc_shr] where no memprof sampling is performed. */
+CAMLextern value caml_alloc_shr_no_track_noexc (mlsize_t, tag_t);
+
+/* Variant of [caml_alloc_shr] where no memprof sampling is performed,
+ and re-using the profinfo associated with the header given in
+ parameter. */
+CAMLextern value caml_alloc_shr_for_minor_gc (mlsize_t, tag_t, header_t);
+
CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz);
CAMLextern void caml_free_dependent_memory (mlsize_t bsz);
CAMLextern void caml_modify (value *, value);
CAMLextern void caml_initialize (value *, value);
CAMLextern value caml_check_urgent_gc (value);
-CAMLextern int caml_init_alloc_for_heap (void);
CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
CAMLextern void caml_free_for_heap (char *mem);
CAMLextern void caml_disown_for_heap (char *mem);
#define DEBUG_clear(result, wosize)
#endif
-#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) do { \
- CAMLassert ((wosize) >= 1); \
- CAMLassert ((tag_t) (tag) < 256); \
- CAMLassert ((wosize) <= Max_young_wosize); \
- caml_young_ptr -= Whsize_wosize (wosize); \
- if (caml_young_ptr < caml_young_trigger){ \
- caml_young_ptr += Whsize_wosize (wosize); \
- CAML_INSTR_INT ("force_minor/alloc_small@", 1); \
- Setup_for_gc; \
- caml_gc_dispatch (); \
- Restore_after_gc; \
- caml_young_ptr -= Whsize_wosize (wosize); \
- } \
- Hd_hp (caml_young_ptr) = \
+enum caml_alloc_small_flags {
+ CAML_DONT_TRACK = 0, CAML_DO_TRACK = 1,
+ CAML_FROM_C = 0, CAML_FROM_CAML = 2
+};
+
+extern void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags);
+// Do not call asynchronous callbacks from allocation functions
+#define Alloc_small_origin CAML_FROM_C
+#define Alloc_small_aux(result, wosize, tag, profinfo, track) do { \
+ CAMLassert ((wosize) >= 1); \
+ CAMLassert ((tag_t) (tag) < 256); \
+ CAMLassert ((wosize) <= Max_young_wosize); \
+ Caml_state_field(young_ptr) -= Whsize_wosize (wosize); \
+ if (Caml_state_field(young_ptr) < Caml_state_field(young_limit)) { \
+ Setup_for_gc; \
+ caml_alloc_small_dispatch((tag), (wosize), \
+ (track) | Alloc_small_origin); \
+ Restore_after_gc; \
+ } \
+ Hd_hp (Caml_state_field(young_ptr)) = \
Make_header_with_profinfo ((wosize), (tag), Caml_black, profinfo); \
- (result) = Val_hp (caml_young_ptr); \
- DEBUG_clear ((result), (wosize)); \
+ (result) = Val_hp (Caml_state_field(young_ptr)); \
+ DEBUG_clear ((result), (wosize)); \
}while(0)
+#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) \
+ Alloc_small_aux(result, wosize, tag, profinfo, CAML_DO_TRACK)
+
#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+
extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat);
+
#define Alloc_small(result, wosize, tag) \
Alloc_small_with_profinfo(result, wosize, tag, \
caml_spacetime_my_profinfo(NULL, wosize))
+#define Alloc_small_no_track(result, wosize, tag) \
+ Alloc_small_aux(result, wosize, tag, \
+ caml_spacetime_my_profinfo(NULL, wosize), CAML_DONT_TRACK)
+
#else
+
#define Alloc_small(result, wosize, tag) \
Alloc_small_with_profinfo(result, wosize, tag, (uintnat) 0)
+#define Alloc_small_no_track(result, wosize, tag) \
+ Alloc_small_aux(result, wosize, tag, (uintnat) 0, CAML_DONT_TRACK)
+
#endif
/* Deprecated alias for [caml_modify] */
value *tables [5];
};
-CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */
+/* Global variable moved to Caml_state in 4.10 */
+#define caml_local_roots (Caml_state_field(local_roots))
/* The following macros are used to declare C local variables and
function parameters of type [value].
*/
#define CAMLparam0() \
- struct caml__roots_block *caml__frame = caml_local_roots
+ struct caml__roots_block *caml__frame = Caml_state_field(local_roots)
#define CAMLparam1(x) \
CAMLparam0 (); \
struct caml__roots_block caml__roots_##x; \
CAMLunused_start int caml__dummy_##x = ( \
(void) caml__frame, \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.next = Caml_state_field(local_roots)), \
+ (Caml_state_field(local_roots) = &caml__roots_##x), \
(caml__roots_##x.nitems = 1), \
(caml__roots_##x.ntables = 1), \
(caml__roots_##x.tables [0] = &x), \
struct caml__roots_block caml__roots_##x; \
CAMLunused_start int caml__dummy_##x = ( \
(void) caml__frame, \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.next = Caml_state_field(local_roots)), \
+ (Caml_state_field(local_roots) = &caml__roots_##x), \
(caml__roots_##x.nitems = 1), \
(caml__roots_##x.ntables = 2), \
(caml__roots_##x.tables [0] = &x), \
struct caml__roots_block caml__roots_##x; \
CAMLunused_start int caml__dummy_##x = ( \
(void) caml__frame, \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.next = Caml_state_field(local_roots)), \
+ (Caml_state_field(local_roots) = &caml__roots_##x), \
(caml__roots_##x.nitems = 1), \
(caml__roots_##x.ntables = 3), \
(caml__roots_##x.tables [0] = &x), \
struct caml__roots_block caml__roots_##x; \
CAMLunused_start int caml__dummy_##x = ( \
(void) caml__frame, \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.next = Caml_state_field(local_roots)), \
+ (Caml_state_field(local_roots) = &caml__roots_##x), \
(caml__roots_##x.nitems = 1), \
(caml__roots_##x.ntables = 4), \
(caml__roots_##x.tables [0] = &x), \
struct caml__roots_block caml__roots_##x; \
CAMLunused_start int caml__dummy_##x = ( \
(void) caml__frame, \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.next = Caml_state_field(local_roots)), \
+ (Caml_state_field(local_roots) = &caml__roots_##x), \
(caml__roots_##x.nitems = 1), \
(caml__roots_##x.ntables = 5), \
(caml__roots_##x.tables [0] = &x), \
struct caml__roots_block caml__roots_##x; \
CAMLunused_start int caml__dummy_##x = ( \
(void) caml__frame, \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.next = Caml_state_field(local_roots)), \
+ (Caml_state_field(local_roots) = &caml__roots_##x), \
(caml__roots_##x.nitems = (size)), \
(caml__roots_##x.ntables = 1), \
(caml__roots_##x.tables[0] = &(x[0])), \
CAMLxparamN (x, (size))
-#define CAMLdrop caml_local_roots = caml__frame
+#define CAMLdrop Caml_state_field(local_roots) = caml__frame
#define CAMLreturn0 do{ \
CAMLdrop; \
#define Begin_roots1(r0) { \
struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
+ caml__roots_block.next = Caml_state_field(local_roots); \
+ Caml_state_field(local_roots) = &caml__roots_block; \
caml__roots_block.nitems = 1; \
caml__roots_block.ntables = 1; \
caml__roots_block.tables[0] = &(r0);
#define Begin_roots2(r0, r1) { \
struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
+ caml__roots_block.next = Caml_state_field(local_roots); \
+ Caml_state_field(local_roots) = &caml__roots_block; \
caml__roots_block.nitems = 1; \
caml__roots_block.ntables = 2; \
caml__roots_block.tables[0] = &(r0); \
#define Begin_roots3(r0, r1, r2) { \
struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
+ caml__roots_block.next = Caml_state_field(local_roots); \
+ Caml_state_field(local_roots) = &caml__roots_block; \
caml__roots_block.nitems = 1; \
caml__roots_block.ntables = 3; \
caml__roots_block.tables[0] = &(r0); \
#define Begin_roots4(r0, r1, r2, r3) { \
struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
+ caml__roots_block.next = Caml_state_field(local_roots); \
+ Caml_state_field(local_roots) = &caml__roots_block; \
caml__roots_block.nitems = 1; \
caml__roots_block.ntables = 4; \
caml__roots_block.tables[0] = &(r0); \
#define Begin_roots5(r0, r1, r2, r3, r4) { \
struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
+ caml__roots_block.next = Caml_state_field(local_roots); \
+ Caml_state_field(local_roots) = &caml__roots_block; \
caml__roots_block.nitems = 1; \
caml__roots_block.ntables = 5; \
caml__roots_block.tables[0] = &(r0); \
#define Begin_roots_block(table, size) { \
struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
+ caml__roots_block.next = Caml_state_field(local_roots); \
+ Caml_state_field(local_roots) = &caml__roots_block; \
caml__roots_block.nitems = (size); \
caml__roots_block.ntables = 1; \
caml__roots_block.tables[0] = (table);
-#define End_roots() caml_local_roots = caml__roots_block.next; }
+#define End_roots() Caml_state_field(local_roots) = caml__roots_block.next; }
/* [caml_register_global_root] registers a global C variable as a memory root
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Jacques-Henri Jourdan, projet Gallium, INRIA Paris */
+/* */
+/* Copyright 2016 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#ifndef CAML_MEMPROF_H
+#define CAML_MEMPROF_H
+
+#ifdef CAML_INTERNALS
+
+#include "config.h"
+#include "mlvalues.h"
+#include "roots.h"
+
+extern int caml_memprof_suspended;
+
+extern value caml_memprof_handle_postponed_exn();
+
+extern void caml_memprof_track_alloc_shr(value block);
+extern void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml);
+extern void caml_memprof_track_interned(header_t* block, header_t* blockend);
+
+extern void caml_memprof_renew_minor_sample(void);
+extern value* caml_memprof_young_trigger;
+
+extern void caml_memprof_scan_roots(scanning_action f);
+
+#endif
+
+#endif /* CAML_MEMPROF_H */
#ifndef CAML_MINOR_GC_H
#define CAML_MINOR_GC_H
-
#include "address_class.h"
#include "config.h"
-CAMLextern value *caml_young_start, *caml_young_end;
-CAMLextern value *caml_young_alloc_start, *caml_young_alloc_end;
-CAMLextern value *caml_young_ptr, *caml_young_limit;
-CAMLextern value *caml_young_trigger;
-extern asize_t caml_minor_heap_wsz;
-extern int caml_in_minor_collection;
-extern double caml_extra_heap_resources_minor;
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_young_start (Caml_state_field(young_start))
+#define caml_young_end (Caml_state_field(young_end))
+#define caml_young_ptr (Caml_state_field(young_ptr))
+#define caml_young_limit (Caml_state_field(young_limit))
+#define caml_young_alloc_start (Caml_state_field(young_alloc_start))
+#define caml_young_alloc_end (Caml_state_field(young_alloc_end))
+#define caml_young_alloc_mid (Caml_state_field(young_alloc_mid))
+#define caml_young_trigger (Caml_state_field(young_trigger))
+#define caml_minor_heap_wsz (Caml_state_field(minor_heap_wsz))
+#define caml_in_minor_collection (Caml_state_field(in_minor_collection))
+#define caml_extra_heap_resources_minor \
+ (Caml_state_field(extra_heap_resources_minor))
+
#define CAML_TABLE_STRUCT(t) { \
t *base; \
}
struct caml_ref_table CAML_TABLE_STRUCT(value *);
-CAMLextern struct caml_ref_table caml_ref_table;
struct caml_ephe_ref_elt {
value ephe; /* an ephemeron in major heap */
};
struct caml_ephe_ref_table CAML_TABLE_STRUCT(struct caml_ephe_ref_elt);
-CAMLextern struct caml_ephe_ref_table caml_ephe_ref_table;
struct caml_custom_elt {
value block; /* The finalized block in the minor heap. */
};
struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt);
-CAMLextern struct caml_custom_table caml_custom_table;
+/* Table of custom blocks in the minor heap that contain finalizers
+ or GC speed parameters. */
extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
extern void caml_empty_minor_heap (void);
CAMLextern void caml_gc_dispatch (void);
+CAMLextern void caml_minor_collection (void);
CAMLextern void garbage_collection (void); /* runtime/signals_nat.c */
+extern void caml_oldify_one (value, value *);
+extern void caml_oldify_mopup (void);
+
extern void caml_realloc_ref_table (struct caml_ref_table *);
extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);
extern void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *);
extern void caml_realloc_custom_table (struct caml_custom_table *);
extern void caml_alloc_custom_table (struct caml_custom_table *,
asize_t, asize_t);
-extern void caml_oldify_one (value, value *);
-extern void caml_oldify_mopup (void);
+void caml_alloc_minor_tables (void);
#define Oldify(p) do{ \
value __oldify__v__ = *p; \
#include <stddef.h>
#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
/* Basic types and constants */
#define NULL 0
#endif
+#if defined(__GNUC__) || defined(__clang__)
+ /* Supported since at least GCC 3.1 */
+ #define CAMLdeprecated_typedef(name, type) \
+ typedef type name __attribute ((deprecated))
+#elif _MSC_VER >= 1310
+ /* NB deprecated("message") only supported from _MSC_VER >= 1400 */
+ #define CAMLdeprecated_typedef(name, type) \
+ typedef __declspec(deprecated) type name
+#else
+ #define CAMLdeprecated_typedef(name, type) typedef type name
+#endif
+
#ifdef CAML_INTERNALS
-typedef char * addr;
+CAMLdeprecated_typedef(addr, char *);
#endif /* CAML_INTERNALS */
/* Noreturn is preserved for compatibility reasons.
#define CAMLweakdef
#endif
+/* Alignment is necessary for domain_state.h, since the code generated */
+/* by ocamlopt makes direct references into the domain state structure,*/
+/* which is stored in a register on many platforms. For this to work, */
+/* we need to be able to compute the exact offset of each member. */
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L
+#define CAMLalign(n) _Alignas(n)
+#elif defined(SUPPORTS_ALIGNED_ATTRIBUTE)
+#define CAMLalign(n) __attribute__((aligned(n)))
+#elif _MSC_VER >= 1500
+#define CAMLalign(n) __declspec(align(n))
+#else
+#error "How do I align values on this platform?"
+#endif
+
+/* CAMLunused is preserved for compatibility reasons.
+ Instead of the legacy GCC/Clang-only
+ CAMLunused foo;
+ you should prefer
+ CAMLunused_start foo CAMLunused_end;
+ which supports both GCC/Clang and MSVC.
+*/
+#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7))
+ #define CAMLunused_start __attribute__ ((unused))
+ #define CAMLunused_end
+ #define CAMLunused __attribute__ ((unused))
+#elif _MSC_VER >= 1500
+ #define CAMLunused_start __pragma( warning (push) ) \
+ __pragma( warning (disable:4189 ) )
+ #define CAMLunused_end __pragma( warning (pop))
+ #define CAMLunused
+#else
+ #define CAMLunused_start
+ #define CAMLunused_end
+ #define CAMLunused
+#endif
+
#ifdef __cplusplus
extern "C" {
#endif
-/* GC timing hooks. These can be assigned by the user.
- [caml_minor_gc_begin_hook] must not allocate nor change any heap value.
- The others can allocate and even call back to OCaml code.
+/* GC timing hooks. These can be assigned by the user. These hooks
+ must not allocate, change any heap value, nor call OCaml code.
*/
typedef void (*caml_timing_hook) (void);
extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook;
extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook;
extern caml_timing_hook caml_finalise_begin_hook, caml_finalise_end_hook;
+#define CAML_STATIC_ASSERT_3(b, l) \
+ CAMLunused_start \
+ CAMLextern char static_assertion_failure_line_##l[(b) ? 1 : -1] \
+ CAMLunused_end
+
+#define CAML_STATIC_ASSERT_2(b, l) CAML_STATIC_ASSERT_3(b, l)
+#define CAML_STATIC_ASSERT(b) CAML_STATIC_ASSERT_2(b, __LINE__)
+
/* Windows Unicode support (rest below - char_os is needed earlier) */
#ifdef _WIN32
#define CAMLassert(x) ((void) 0)
#endif
+/* This hook is called when a fatal error occurs in the OCaml
+ runtime. It is given arguments to be passed to the [vprintf]-like
+ functions in order to synthetize the error message.
+ If it returns, the runtime calls [abort()].
+
+ If it is [NULL], the error message is printed on stderr and then
+ [abort()] is called. */
+extern void (*caml_fatal_error_hook) (char *msg, va_list args);
+
CAMLnoreturn_start
CAMLextern void caml_fatal_error (char *, ...)
#ifdef __GNUC__
extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res);
#endif
+/* From floats.c */
+extern double caml_log1p(double);
+
/* Windows Unicode support */
#ifdef _WIN32
#define strcmp_os wcscmp
#define strlen_os wcslen
#define sscanf_os swscanf
+#define strcpy_os wcscpy
+#define mktemp_os _wmktemp
+#define fopen_os _wfopen
#define caml_stat_strdup_os caml_stat_wcsdup
#define caml_stat_strconcat_os caml_stat_wcsconcat
#define strcmp_os strcmp
#define strlen_os strlen
#define sscanf_os sscanf
+#define strcpy_os strcpy
+#define mktemp_os mktemp
+#define fopen_os fopen
#define caml_stat_strdup_os caml_stat_strdup
#define caml_stat_strconcat_os caml_stat_strconcat
01 -> fields of free list blocks in major heap
03 -> heap chunks deallocated by heap shrinking
04 -> fields deallocated by [caml_obj_truncate]
+ 05 -> unused child pointers in large free blocks
10 -> uninitialised fields of minor objects
11 -> uninitialised fields of major objects
15 -> uninitialised words of [caml_stat_alloc_aligned] blocks
#define Debug_free_major Debug_tag (0x01)
#define Debug_free_shrink Debug_tag (0x03)
#define Debug_free_truncate Debug_tag (0x04)
+#define Debug_free_unused Debug_tag (0x05)
#define Debug_uninit_minor Debug_tag (0x10)
#define Debug_uninit_major Debug_tag (0x11)
#define Debug_uninit_align Debug_tag (0x15)
#include <time.h>
#include <stdio.h>
-extern intnat caml_stat_minor_collections;
extern intnat caml_instr_starttime, caml_instr_stoptime;
struct caml_instr_block {
/* Allocate the data block for a given name.
[t] must have been declared with [CAML_INSTR_DECLARE]. */
-#define CAML_INSTR_ALLOC(t) do{ \
- if (caml_stat_minor_collections >= caml_instr_starttime \
- && caml_stat_minor_collections < caml_instr_stoptime){ \
- t = caml_stat_alloc_noexc (sizeof (struct caml_instr_block)); \
- t->index = 0; \
- t->tag[0] = ""; \
- t->next = caml_instr_log; \
- caml_instr_log = t; \
- } \
+#define CAML_INSTR_ALLOC(t) do{ \
+ if (Caml_state_field(stat_minor_collections) >= caml_instr_starttime \
+ && Caml_state_field(stat_minor_collections) < caml_instr_stoptime){ \
+ t = caml_stat_alloc_noexc (sizeof (struct caml_instr_block)); \
+ t->index = 0; \
+ t->tag[0] = ""; \
+ t->next = caml_instr_log; \
+ caml_instr_log = t; \
+ } \
}while(0)
/* Allocate the data block and start the timer.
#endif /* CAML_INSTR */
+/* Macro used to deactivate thread and address sanitizers on some
+ functions. */
+#define CAMLno_tsan
+#define CAMLno_asan
+#if defined(__has_feature)
+# if __has_feature(thread_sanitizer)
+# undef CAMLno_tsan
+# define CAMLno_tsan __attribute__((no_sanitize("thread")))
+# endif
+# if __has_feature(address_sanitizer)
+# undef CAMLno_asan
+# define CAMLno_asan __attribute__((no_sanitize("address")))
+# endif
+#endif
+
+/* A table of all code fragments (main program and dynlinked modules) */
+struct code_fragment {
+ char *code_start;
+ char *code_end;
+ unsigned char digest[16];
+ char digest_computed;
+};
+
+extern struct ext_table caml_code_fragments_table;
+
+int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf);
+
#endif /* CAML_INTERNALS */
+/* The [backtrace_slot] type represents values stored in
+ * [Caml_state->backtrace_buffer]. In bytecode, it is the same as a
+ * [code_t], in native code it as a [frame_descr *]. The difference
+ * doesn't matter for code outside [backtrace_{byt,nat}.c],
+ * so it is just exposed as a [void *].
+ */
+typedef void * backtrace_slot;
+
#ifdef __cplusplus
}
#endif
typedef uintnat color_t;
typedef uintnat mark_t;
+#include "domain_state.h"
+
/* Longs vs blocks. */
#define Is_long(x) (((x) & 1) != 0)
#define Is_block(x) (((x) & 1) == 0)
#define Unsigned_long_val(x) ((uintnat)(x) >> 1)
#define Unsigned_int_val(x) ((int) Unsigned_long_val(x))
+/* Encoded exceptional return values, when functions are suffixed with
+ _exn. Encoded exceptions are invalid values and must not be seen
+ by the garbage collector. */
+#define Make_exception_result(v) ((v) | 2)
+#define Is_exception_result(v) (((v) & 3) == 2)
+#define Extract_exception(v) ((v) & ~3)
+
/* Structure of the header:
For 16-bit and 32-bit architectures:
CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
struct caml__roots_block *);
#else
-CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
- uintnat last_retaddr, value * gc_regs,
- struct caml__roots_block * local_roots);
+CAMLextern void caml_do_local_roots(scanning_action f, char * c_bottom_of_stack,
+ uintnat last_retaddr, value * v_gc_regs,
+ struct caml__roots_block * gc_local_roots);
#endif
CAMLextern void (*caml_scan_roots_hook) (scanning_action);
#undef HAS_EXECVPE
+#undef HAS_FFS
+#undef HAS_BITSCANFORWARD
+
#undef HAS_STACK_OVERFLOW_DETECTION
#undef HAS_SIGWAIT
extern "C" {
#endif
+CAMLextern void caml_enter_blocking_section (void);
+CAMLextern void caml_leave_blocking_section (void);
+
+CAMLextern void caml_process_pending_actions (void);
+/* Checks for pending actions and executes them. This includes pending
+ minor and major collections, signal handlers, finalisers, and
+ Memprof callbacks. Assumes that the runtime lock is held. Can raise
+ exceptions asynchronously into OCaml code. */
+
+CAMLextern value caml_process_pending_actions_exn (void);
+/* Same as [caml_process_pending_actions], but returns the exception
+ if any (otherwise returns [Val_unit]). */
+
#ifdef CAML_INTERNALS
-CAMLextern intnat volatile caml_signals_are_pending;
CAMLextern intnat volatile caml_pending_signals[];
+
+/* When an action is pending, either [caml_something_to_do] is 1, or
+ there is a function currently running which will end by either
+ executing all actions, or set [caml_something_to_do] back to 1. We
+ set it to 0 when starting executing all callbacks.
+
+ In the case there are two different callbacks (say, a signal and a
+ finaliser) arriving at the same time, then the processing of one
+ awaits the return of the other. In case of long-running callbacks,
+ we may want to run the second one without waiting the end of the
+ first one. We do this by provoking an additional polling every
+ minor collection and every major slice. To guarantee a low latency
+ for signals, we avoid delaying signal handlers in that case by
+ calling them first.
+
+ FIXME: We could get into caml_process_pending_actions when
+ caml_something_to_do is seen as set but not caml_pending_signals,
+ making us miss the signal.
+*/
CAMLextern int volatile caml_something_to_do;
-extern int volatile caml_requested_major_slice;
-extern int volatile caml_requested_minor_gc;
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_requested_major_slice (Caml_state_field(requested_major_slice))
+#define caml_requested_minor_gc (Caml_state_field(requested_minor_gc))
+
+void caml_update_young_limit(void);
void caml_request_major_slice (void);
void caml_request_minor_gc (void);
CAMLextern int caml_convert_signal_number (int);
CAMLextern int caml_rev_convert_signal_number (int);
-void caml_execute_signal(int signal_number, int in_signal_handler);
+value caml_execute_signal_exn(int signal_number, int in_signal_handler);
void caml_record_signal(int signal_number);
-void caml_process_pending_signals(void);
-void caml_process_event(void);
+value caml_process_pending_signals_exn(void);
+void caml_set_action_pending (void);
+value caml_do_pending_actions_exn (void);
+value caml_process_pending_actions_with_root (value extra_root); // raises
int caml_set_signal_action(int signo, int action);
+void caml_setup_stack_overflow_detection(void);
CAMLextern void (*caml_enter_blocking_section_hook)(void);
CAMLextern void (*caml_leave_blocking_section_hook)(void);
CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
-CAMLextern void (* volatile caml_async_action_hook)(void);
#ifdef POSIX_SIGNALS
CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
#endif
#endif /* CAML_INTERNALS */
-CAMLextern void caml_enter_blocking_section (void);
-CAMLextern void caml_leave_blocking_section (void);
-
#ifdef __cplusplus
}
#endif
extern uintnat (*caml_stack_usage_hook)(void);
/* Declaration of variables used in the asm code */
-extern char * caml_top_of_stack;
-extern char * caml_bottom_of_stack;
-extern uintnat caml_last_return_address;
-extern value * caml_gc_regs;
-extern char * caml_exception_pointer;
extern value * caml_globals[];
extern char caml_globals_map[];
extern intnat caml_globals_inited;
extern intnat * caml_frametable[];
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_top_of_stack (Caml_state_field(top_of_stack))
+#define caml_bottom_of_stack (Caml_state_field(bottom_of_stack))
+#define caml_last_return_address (Caml_state_field(last_return_address))
+#define caml_gc_regs (Caml_state_field(gc_regs))
+#define caml_exception_pointer (Caml_state_field(exception_pointer))
+
CAMLextern frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp);
#endif /* CAML_INTERNALS */
#include "mlvalues.h"
#include "memory.h"
-CAMLextern value * caml_stack_low;
-CAMLextern value * caml_stack_high;
-CAMLextern value * caml_stack_threshold;
-CAMLextern value * caml_extern_sp;
-CAMLextern value * caml_trapsp;
-CAMLextern value * caml_trap_barrier;
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_stack_low (Caml_state_field(stack_low))
+#define caml_stack_high (Caml_state_field(stack_high))
+#define caml_stack_threshold (Caml_state_field(stack_threshold))
+#define caml_extern_sp (Caml_state_field(extern_sp))
+#define caml_trapsp (Caml_state_field(trapsp))
+#define caml_trap_barrier (Caml_state_field(trap_barrier))
#define Trap_pc(tp) (((code_t *)(tp))[0])
#define Trap_link(tp) (((value **)(tp))[1])
#define CAML_WEAK_H
#include "mlvalues.h"
+#include "memory.h"
#ifdef __cplusplus
extern "C" {
}else{
Field (v, i) = child = f;
if (Is_block (f) && Is_young (f))
- add_to_ephe_ref_table(&caml_ephe_ref_table, v, i);
+ add_to_ephe_ref_table(Caml_state_field(ephe_ref_table), v, i);
goto ephemeron_again;
}
}
return adr;
}
-static void do_compaction (void)
+static void do_compaction (intnat new_allocation_policy)
{
char *ch, *chend;
CAMLassert (caml_gc_phase == Phase_idle);
}
}
- /* Rebuild the free list. */
+ /* Rebuild the free list. This is the right time for a change of
+ allocation policy, since we are rebuilding the allocator's data
+ structures from scratch. */
{
ch = caml_heap_start;
+ if (new_allocation_policy != -1){
+ caml_set_allocation_policy (new_allocation_policy);
+ }
caml_fl_reset ();
while (ch != NULL){
if (Chunk_size (ch) > Chunk_alloc (ch)){
ch = Chunk_next (ch);
}
}
- ++ caml_stat_compactions;
+ ++ Caml_state->stat_compactions;
caml_gc_message (0x10, "done.\n");
}
uintnat caml_percent_max; /* used in gc_ctrl.c and memory.c */
-void caml_compact_heap (void)
+void caml_compact_heap (intnat new_allocation_policy)
{
uintnat target_wsz, live;
CAML_INSTR_SETUP(tmr, "compact");
- CAMLassert (caml_young_ptr == caml_young_alloc_end);
- CAMLassert (caml_ref_table.ptr == caml_ref_table.base);
- CAMLassert (caml_ephe_ref_table.ptr == caml_ephe_ref_table.base);
- CAMLassert (caml_custom_table.ptr == caml_custom_table.base);
+ CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end);
+ CAMLassert (Caml_state->ref_table->ptr ==
+ Caml_state->ref_table->base);
+ CAMLassert (Caml_state->ephe_ref_table->ptr ==
+ Caml_state->ephe_ref_table->base);
+ CAMLassert (Caml_state->custom_table->ptr ==
+ Caml_state->custom_table->base);
- do_compaction ();
+ do_compaction (new_allocation_policy);
CAML_INSTR_TIME (tmr, "compact/main");
/* Compaction may fail to shrink the heap to a reasonable size
because it deals in complete chunks: if a very large chunk
We recompact if target_wsz < heap_size / 2
*/
- live = caml_stat_heap_wsz - caml_fl_cur_wsz;
+ live = Caml_state->stat_heap_wsz - caml_fl_cur_wsz;
target_wsz = live + caml_percent_free * (live / 100 + 1)
+ Wsize_bsize (Page_size);
target_wsz = caml_clip_heap_chunk_wsz (target_wsz);
#ifdef HAS_HUGE_PAGES
if (caml_use_huge_pages
- && Bsize_wsize (caml_stat_heap_wsz) <= HUGE_PAGE_SIZE)
+ && Bsize_wsize (Caml_state->stat_heap_wsz) <= HUGE_PAGE_SIZE)
return;
#endif
- if (target_wsz < caml_stat_heap_wsz / 2){
+ if (target_wsz < Caml_state->stat_heap_wsz / 2){
/* Recompact. */
char *chunk;
}
Chunk_next (chunk) = caml_heap_start;
caml_heap_start = chunk;
- ++ caml_stat_heap_chunks;
- caml_stat_heap_wsz += Wsize_bsize (Chunk_size (chunk));
- if (caml_stat_heap_wsz > caml_stat_top_heap_wsz){
- caml_stat_top_heap_wsz = caml_stat_heap_wsz;
+ ++ Caml_state->stat_heap_chunks;
+ Caml_state->stat_heap_wsz += Wsize_bsize (Chunk_size (chunk));
+ if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){
+ Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
}
- do_compaction ();
- CAMLassert (caml_stat_heap_chunks == 1);
+ do_compaction (-1);
+ CAMLassert (Caml_state->stat_heap_chunks == 1);
CAMLassert (Chunk_next (caml_heap_start) == NULL);
- CAMLassert (caml_stat_heap_wsz == Wsize_bsize (Chunk_size (chunk)));
+ CAMLassert (Caml_state->stat_heap_wsz == Wsize_bsize (Chunk_size (chunk)));
CAML_INSTR_TIME (tmr, "compact/recompact");
}
}
FW = fl_size_at_phase_change + 3 * (caml_fl_cur_wsz
- caml_fl_wsz_at_phase_change)
FW = 3 * caml_fl_cur_wsz - 2 * caml_fl_wsz_at_phase_change
- Estimated live words: LW = caml_stat_heap_wsz - FW
+ Estimated live words: LW = Caml_state->stat_heap_wsz - FW
Estimated free percentage: FP = 100 * FW / LW
We compact the heap if FP > caml_percent_max
*/
double fw, fp;
CAMLassert (caml_gc_phase == Phase_idle);
if (caml_percent_max >= 1000000) return;
- if (caml_stat_major_collections < 3) return;
- if (caml_stat_heap_wsz <= 2 * caml_clip_heap_chunk_wsz (0)) return;
+ if (Caml_state->stat_major_collections < 3) return;
+ if (Caml_state->stat_heap_wsz <= 2 * caml_clip_heap_chunk_wsz (0)) return;
#ifdef HAS_HUGE_PAGES
if (caml_use_huge_pages
- && Bsize_wsize (caml_stat_heap_wsz) <= HUGE_PAGE_SIZE)
+ && Bsize_wsize (Caml_state->stat_heap_wsz) <= HUGE_PAGE_SIZE)
return;
#endif
fw = 3.0 * caml_fl_cur_wsz - 2.0 * caml_fl_wsz_at_phase_change;
if (fw < 0) fw = caml_fl_cur_wsz;
- if (fw >= caml_stat_heap_wsz){
+ if (fw >= Caml_state->stat_heap_wsz){
fp = 1000000.0;
}else{
- fp = 100.0 * fw / (caml_stat_heap_wsz - fw);
+ fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
if (fp > 1000000.0) fp = 1000000.0;
}
caml_gc_message (0x200, "FL size at phase change = %"
caml_finish_major_cycle ();
fw = caml_fl_cur_wsz;
- fp = 100.0 * fw / (caml_stat_heap_wsz - fw);
+ fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
caml_gc_message (0x200, "Measured overhead: %"
ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
(uintnat) fp);
if (fp >= caml_percent_max)
- caml_compact_heap ();
+ caml_compact_heap (-1);
else
caml_gc_message (0x200, "Automatic compaction aborted.\n");
#define COMPARE_STACK_INIT_SIZE 8
#define COMPARE_STACK_MIN_ALLOC_SIZE 32
#define COMPARE_STACK_MAX_SIZE (1024*1024)
-CAMLexport int caml_compare_unordered;
struct compare_stack {
struct compare_item init_stack[COMPARE_STACK_INIT_SIZE];
int res;
int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext;
if (compare == NULL) break; /* for backward compatibility */
- caml_compare_unordered = 0;
+ Caml_state->compare_unordered = 0;
res = compare(v1, v2);
- if (caml_compare_unordered && !total) return UNORDERED;
+ if (Caml_state->compare_unordered && !total) return UNORDERED;
if (res != 0) return res;
goto next_item;
}
int res;
int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext;
if (compare == NULL) break; /* for backward compatibility */
- caml_compare_unordered = 0;
+ Caml_state->compare_unordered = 0;
res = compare(v1, v2);
- if (caml_compare_unordered && !total) return UNORDERED;
+ if (Caml_state->compare_unordered && !total) return UNORDERED;
if (res != 0) return res;
goto next_item;
}
compare_free_stack(stk);
caml_invalid_argument("compare: abstract value");
}
- caml_compare_unordered = 0;
+ Caml_state->compare_unordered = 0;
res = compare(v1, v2);
- if (caml_compare_unordered && !total) return UNORDERED;
+ if (Caml_state->compare_unordered && !total) return UNORDERED;
if (res != 0) return res;
break;
}
}
/* The remaining [mem_minor] will be counted if the block survives a
minor GC */
- add_to_custom_table (&caml_custom_table, result, mem_minor, max_major);
+ add_to_custom_table (Caml_state->custom_table, result,
+ mem_minor, max_major);
/* Keep track of extra resources held by custom block in
minor heap. */
if (mem_minor != 0) {
if (max_minor == 0) max_minor = 1;
- caml_extra_heap_resources_minor +=
+ Caml_state->extra_heap_resources_minor +=
(double) mem_minor / (double) max_minor;
- if (caml_extra_heap_resources_minor > 1.0) {
- caml_request_minor_gc ();
- caml_gc_dispatch ();
- }
+ if (Caml_state->extra_heap_resources_minor > 1.0)
+ caml_minor_collection ();
}
}
} else {
result = caml_alloc_shr(wosize, Custom_tag);
Custom_ops_val(result) = ops;
caml_adjust_gc_speed(mem, max_major);
- result = caml_check_urgent_gc(result);
+ caml_check_urgent_gc(Val_unit);
}
CAMLreturn(result);
}
the major GC takes 1.5 cycles (previous cycle + marking phase) before
it starts to deallocate dead blocks allocated during the previous cycle.
[heap_size / 150] is really [heap_size * (2/3) / 100] (but faster). */
- Bsize_wsize (caml_stat_heap_wsz) / 150 * caml_custom_major_ratio;
+ Bsize_wsize (Caml_state->stat_heap_wsz) / 150 * caml_custom_major_ratio;
mlsize_t max_minor =
- Bsize_wsize (caml_minor_heap_wsz) / 100 * caml_custom_minor_ratio;
+ Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio;
return alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor);
}
{
}
-void caml_debugger(enum event_kind event)
+void caml_debugger(enum event_kind event, value param)
{
}
static char *dbg_addr = NULL;
+static struct ext_table breakpoints_table;
+
static void open_connection(void)
{
#ifdef _WIN32
if (dbg_addr != NULL) caml_stat_free(dbg_addr);
dbg_addr = address;
+ caml_ext_table_init(&breakpoints_table, 16);
+
#ifdef _WIN32
winsock_startup();
(void)atexit(winsock_cleanup);
host = gethostbyname(address);
if (host == NULL)
caml_fatal_error("unknown debugging host %s", address);
- memmove(&sock_addr.s_inet.sin_addr, host->h_addr, host->h_length);
+ memmove(&sock_addr.s_inet.sin_addr,
+ host->h_addr_list[0], host->h_length);
}
sock_addr.s_inet.sin_port = htons(atoi(port));
sock_addr_len = sizeof(sock_addr.s_inet);
}
open_connection();
caml_debugger_in_use = 1;
- caml_trap_barrier = caml_stack_high;
+ Caml_state->trap_barrier = Caml_state->stack_high;
}
static value getval(struct channel *chan)
struct longjmp_buffer raise_buf, * saved_external_raise;
/* Catch exceptions raised by [caml_output_val] */
- saved_external_raise = caml_external_raise;
+ saved_external_raise = Caml_state->external_raise;
if (sigsetjmp(raise_buf.buf, 0) == 0) {
- caml_external_raise = &raise_buf;
+ Caml_state->external_raise = &raise_buf;
caml_output_val(chan, val, marshal_flags);
} else {
/* Send wrong magic number, will cause [caml_input_value] to fail */
caml_really_putblock(chan, "\000\000\000\000", 4);
}
- caml_external_raise = saved_external_raise;
+ Caml_state->external_raise = saved_external_raise;
+}
+
+struct breakpoint {
+ code_t pc;
+ opcode_t saved;
+};
+
+static struct breakpoint *find_breakpoint(code_t pc)
+{
+ struct breakpoint *bpti;
+ int i;
+
+ for (i = 0; i < breakpoints_table.size; i++) {
+ bpti = (struct breakpoint *) breakpoints_table.contents[i];
+ if (bpti->pc == pc)
+ return bpti;
+ }
+
+ return NULL;
+}
+
+static void save_instruction(code_t pc)
+{
+ struct breakpoint *bpt;
+
+ if (find_breakpoint(pc) != NULL) {
+ /* Already saved. Nothing to do. */
+ return;
+ }
+
+ bpt = caml_stat_alloc(sizeof(struct breakpoint));
+ bpt->pc = pc;
+ bpt->saved = *pc;
+ caml_ext_table_add(&breakpoints_table, bpt);
+}
+
+static void set_instruction(code_t pc, opcode_t opcode)
+{
+ save_instruction(pc);
+ caml_set_instruction(pc, opcode);
+}
+
+static void restore_instruction(code_t pc)
+{
+ struct breakpoint *bpt = find_breakpoint(pc);
+ CAMLassert (bpt != NULL);
+
+ *pc = bpt->saved;
+ caml_ext_table_remove(&breakpoints_table, bpt);
+}
+
+static code_t pc_from_pos(int frag, intnat pos)
+{
+ struct code_fragment *cf;
+ CAMLassert (frag >= 0);
+ CAMLassert (frag < caml_code_fragments_table.size);
+ CAMLassert (pos >= 0);
+ CAMLassert (pos < caml_code_size);
+
+ cf = (struct code_fragment *) caml_code_fragments_table.contents[frag];
+ return (code_t) (cf->code_start + pos);
+}
+
+opcode_t caml_debugger_saved_instruction(code_t pc)
+{
+ struct breakpoint *bpt = find_breakpoint(pc);
+ CAMLassert (bpt != NULL);
+
+ return bpt->saved;
+}
+
+void caml_debugger_code_unloaded(int index)
+{
+ struct code_fragment *cf;
+ struct breakpoint *bpti;
+ int i;
+
+ if (!caml_debugger_in_use) return;
+
+ caml_putch(dbg_out, REP_CODE_UNLOADED);
+ caml_putword(dbg_out, index);
+
+ cf = (struct code_fragment *) caml_code_fragments_table.contents[index];
+
+ for (i = 0; i < breakpoints_table.size; i++) {
+ bpti = (struct breakpoint *) breakpoints_table.contents[i];
+ if ((char*) bpti->pc >= cf->code_start && (char*) bpti->pc < cf->code_end) {
+ caml_ext_table_remove(&breakpoints_table, bpti);
+ /* caml_ext_table_remove has shifted the next element in place
+ of the one we just removed. Decrement i for the next
+ iteration. */
+ i--;
+ }
+ }
}
#define Pc(sp) ((code_t)((sp)[0]))
#define Extra_args(sp) (Long_val(((sp)[2])))
#define Locals(sp) ((sp) + 3)
-void caml_debugger(enum event_kind event)
+void caml_debugger(enum event_kind event, value param)
{
- value * frame;
+ value *frame, *newframe;
intnat i, pos;
value val;
+ int frag, found = 0;
+ struct code_fragment *cf;
+ (void) found; /* Silence unused variable warning. */
if (dbg_socket == -1) return; /* Not connected to a debugger. */
/* Reset current frame */
- frame = caml_extern_sp + 1;
+ frame = Caml_state->extern_sp + 1;
/* Report the event to the debugger */
switch(event) {
case PROGRAM_START: /* Nothing to report */
+ CAMLassert (param == Val_unit);
goto command_loop;
case EVENT_COUNT:
+ CAMLassert (param == Val_unit);
caml_putch(dbg_out, REP_EVENT);
break;
case BREAKPOINT:
+ CAMLassert (param == Val_unit);
caml_putch(dbg_out, REP_BREAKPOINT);
break;
case PROGRAM_EXIT:
+ CAMLassert (param == Val_unit);
caml_putch(dbg_out, REP_EXITED);
break;
case TRAP_BARRIER:
+ CAMLassert (param == Val_unit);
caml_putch(dbg_out, REP_TRAP);
break;
case UNCAUGHT_EXC:
+ CAMLassert (param == Val_unit);
caml_putch(dbg_out, REP_UNCAUGHT_EXC);
break;
+ case DEBUG_INFO_ADDED:
+ caml_putch(dbg_out, REP_CODE_DEBUG_INFO);
+ caml_output_val(dbg_out, /* debug_info */ param, Val_emptylist);
+ break;
+ case CODE_LOADED:
+ caml_putch(dbg_out, REP_CODE_LOADED);
+ caml_putword(dbg_out, /* index */ Long_val(param));
+ break;
+ case CODE_UNLOADED:
+ caml_putch(dbg_out, REP_CODE_UNLOADED);
+ caml_putword(dbg_out, /* index */ Long_val(param));
+ break;
}
caml_putword(dbg_out, caml_event_count);
if (event == EVENT_COUNT || event == BREAKPOINT) {
- caml_putword(dbg_out, caml_stack_high - frame);
- caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t));
+ caml_putword(dbg_out, Caml_state->stack_high - frame);
+ found = caml_find_code_fragment((char*) Pc(frame), &frag, &cf);
+ CAMLassert(found);
+ caml_putword(dbg_out, frag);
+ caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start);
} else {
/* No PC and no stack frame associated with other events */
caml_putword(dbg_out, 0);
+ caml_putword(dbg_out, -1);
caml_putword(dbg_out, 0);
}
caml_flush(dbg_out);
while(1) {
switch(caml_getch(dbg_in)) {
case REQ_SET_EVENT:
+ frag = caml_getword(dbg_in);
pos = caml_getword(dbg_in);
- CAMLassert (pos >= 0);
- CAMLassert (pos < caml_code_size);
- caml_set_instruction(caml_start_code + pos / sizeof(opcode_t), EVENT);
+ set_instruction(pc_from_pos(frag, pos), EVENT);
break;
case REQ_SET_BREAKPOINT:
+ frag = caml_getword(dbg_in);
pos = caml_getword(dbg_in);
- CAMLassert (pos >= 0);
- CAMLassert (pos < caml_code_size);
- caml_set_instruction(caml_start_code + pos / sizeof(opcode_t), BREAK);
+ set_instruction(pc_from_pos(frag, pos), BREAK);
break;
case REQ_RESET_INSTR:
+ frag = caml_getword(dbg_in);
pos = caml_getword(dbg_in);
- CAMLassert (pos >= 0);
- CAMLassert (pos < caml_code_size);
- pos = pos / sizeof(opcode_t);
- caml_set_instruction(caml_start_code + pos, caml_saved_code[pos]);
+ restore_instruction(pc_from_pos(frag, pos));
break;
case REQ_CHECKPOINT:
#ifndef _WIN32
}
#else
caml_fatal_error("REQ_CHECKPOINT command");
- exit(-1);
#endif
break;
case REQ_GO:
wait(NULL);
#else
caml_fatal_error("REQ_WAIT command");
- exit(-1);
#endif
break;
case REQ_INITIAL_FRAME:
- frame = caml_extern_sp + 1;
+ frame = Caml_state->extern_sp + 1;
/* Fall through */
case REQ_GET_FRAME:
- caml_putword(dbg_out, caml_stack_high - frame);
- if (frame < caml_stack_high){
- caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t));
- }else{
- caml_putword (dbg_out, 0);
+ caml_putword(dbg_out, Caml_state->stack_high - frame);
+ if (frame < Caml_state->stack_high &&
+ caml_find_code_fragment((char*) Pc(frame), &frag, &cf)) {
+ caml_putword(dbg_out, frag);
+ caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start);
+ } else {
+ caml_putword(dbg_out, 0);
+ caml_putword(dbg_out, 0);
}
caml_flush(dbg_out);
break;
case REQ_SET_FRAME:
i = caml_getword(dbg_in);
- frame = caml_stack_high - i;
+ frame = Caml_state->stack_high - i;
break;
case REQ_UP_FRAME:
i = caml_getword(dbg_in);
- if (frame + Extra_args(frame) + i + 3 >= caml_stack_high) {
+ newframe = frame + Extra_args(frame) + i + 3;
+ if (newframe >= Caml_state->stack_high ||
+ !caml_find_code_fragment((char*) Pc(newframe), &frag, &cf)) {
caml_putword(dbg_out, -1);
} else {
- frame += Extra_args(frame) + i + 3;
- caml_putword(dbg_out, caml_stack_high - frame);
- caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t));
+ frame = newframe;
+ caml_putword(dbg_out, Caml_state->stack_high - frame);
+ caml_putword(dbg_out, frag);
+ caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start);
}
caml_flush(dbg_out);
break;
case REQ_SET_TRAP_BARRIER:
i = caml_getword(dbg_in);
- caml_trap_barrier = caml_stack_high - i;
+ Caml_state->trap_barrier = Caml_state->stack_high - i;
break;
case REQ_GET_LOCAL:
i = caml_getword(dbg_in);
caml_flush(dbg_out);
break;
case REQ_GET_ACCU:
- putval(dbg_out, *caml_extern_sp);
+ putval(dbg_out, *Caml_state->extern_sp);
caml_flush(dbg_out);
break;
case REQ_GET_HEADER:
break;
case REQ_GET_CLOSURE_CODE:
val = getval(dbg_in);
- caml_putword(dbg_out, (Code_val(val)-caml_start_code) * sizeof(opcode_t));
+ found = caml_find_code_fragment((char*) Code_val(val), &frag, &cf);
+ CAMLassert(found);
+ caml_putword(dbg_out, frag);
+ caml_putword(dbg_out, (char*) Code_val(val) - cf->code_start);
caml_flush(dbg_out);
break;
case REQ_SET_FORK_MODE:
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include "caml/domain_state.h"
+#include "caml/memory.h"
+
+CAMLexport caml_domain_state* Caml_state;
+
+void caml_init_domain ()
+{
+ if (Caml_state != NULL)
+ return;
+
+ Caml_state =
+ (caml_domain_state*)caml_stat_alloc_noexc(sizeof(caml_domain_state));
+ if (Caml_state == NULL)
+ caml_fatal_error ("cannot initialize domain state");
+
+ Caml_state->young_limit = NULL;
+ Caml_state->exception_pointer = NULL;
+
+ Caml_state->young_ptr = NULL;
+ Caml_state->young_base = NULL;
+ Caml_state->young_start = NULL;
+ Caml_state->young_end = NULL;
+ Caml_state->young_alloc_start = NULL;
+ Caml_state->young_alloc_mid = NULL;
+ Caml_state->young_alloc_end = NULL;
+ Caml_state->young_trigger = NULL;
+ Caml_state->minor_heap_wsz = 0;
+ Caml_state->in_minor_collection = 0;
+ Caml_state->extra_heap_resources_minor = 0;
+ caml_alloc_minor_tables();
+
+ Caml_state->stack_low = NULL;
+ Caml_state->stack_high = NULL;
+ Caml_state->stack_threshold = NULL;
+ Caml_state->extern_sp = NULL;
+ Caml_state->trapsp = NULL;
+ Caml_state->trap_barrier = NULL;
+ Caml_state->external_raise = NULL;
+ Caml_state->exn_bucket = Val_unit;
+
+ Caml_state->top_of_stack = NULL;
+ Caml_state->bottom_of_stack = NULL; /* no stack initially */
+ Caml_state->last_return_address = 1; /* not in OCaml code initially */
+ Caml_state->gc_regs = NULL;
+
+ Caml_state->stat_minor_words = 0.0;
+ Caml_state->stat_promoted_words = 0.0;
+ Caml_state->stat_major_words = 0.0;
+ Caml_state->stat_minor_collections = 0;
+ Caml_state->stat_major_collections = 0;
+ Caml_state->stat_heap_wsz = 0;
+ Caml_state->stat_top_heap_wsz = 0;
+ Caml_state->stat_compactions = 0;
+ Caml_state->stat_heap_chunks = 0;
+
+ Caml_state->backtrace_active = 0;
+ Caml_state->backtrace_pos = 0;
+ Caml_state->backtrace_buffer = NULL;
+ Caml_state->backtrace_last_exn = Val_unit;
+
+ Caml_state->compare_unordered = 0;
+ Caml_state->local_roots = NULL;
+ Caml_state->requested_major_slice = 0;
+ Caml_state->requested_minor_gc = 0;
+}
io.c extern.c intern.c hash.c sys.c meta.c parsing.c gc_ctrl.c md5.c
obj.c lexing.c callback.c debugger.c weak.c compact.c finalise.c
custom.c dynlink.c spacetime_byt.c afl.c unix.c win32.c bigarray.c
- main.c)
+ main.c memprof.c domain.c)
(action
(progn
(bash "touch .depend") ; hack.
}
}
}
- else if ((cf = caml_extern_find_code((char *) v)) != NULL) {
+ else if (caml_find_code_fragment((char*) v, NULL, &cf)) {
if ((extern_flags & CLOSURES) == 0)
extern_invalid_argument("output_value: functional value");
+ if (! cf->digest_computed) {
+ caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
+ cf->digest_computed = 1;
+ }
writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start);
writeblock((const char *)cf->digest, 16);
} else {
}
#endif
}
-
-/* Find where a code pointer comes from */
-
-CAMLexport struct code_fragment * caml_extern_find_code(char *addr)
-{
- int i;
- for (i = caml_code_fragments_table.size - 1; i >= 0; i--) {
- struct code_fragment * cf = caml_code_fragments_table.contents[i];
- if (! cf->digest_computed) {
- caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
- cf->digest_computed = 1;
- }
- if (cf->code_start <= addr && addr < cf->code_end) return cf;
- }
- return NULL;
-}
#include <stdio.h>
#include <stdlib.h>
#include "caml/alloc.h"
+#include "caml/callback.h"
#include "caml/fail.h"
-#include "caml/io.h"
#include "caml/gc.h"
+#include "caml/io.h"
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/signals.h"
#include "caml/stacks.h"
-CAMLexport struct longjmp_buffer * caml_external_raise = NULL;
-value caml_exn_bucket;
-
CAMLexport void caml_raise(value v)
{
Unlock_exn();
- caml_exn_bucket = v;
- if (caml_external_raise == NULL) caml_fatal_uncaught_exception(v);
- siglongjmp(caml_external_raise->buf, 1);
+ Caml_state->exn_bucket = v;
+ if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v);
+ siglongjmp(Caml_state->external_raise->buf, 1);
}
CAMLexport void caml_raise_constant(value tag)
caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO));
}
+value caml_raise_if_exception(value res)
+{
+ if (Is_exception_result(res)) caml_raise(Extract_exception(res));
+ return res;
+}
+
int caml_is_special_exception(value exn) {
/* this function is only used in caml_format_exception to produce
a more readable textual representation of some exceptions. It is
#include <stdio.h>
#include <signal.h>
#include "caml/alloc.h"
+#include "caml/domain.h"
#include "caml/fail.h"
#include "caml/io.h"
#include "caml/gc.h"
/* Exception raising */
CAMLnoreturn_start
- extern void caml_raise_exception (value bucket)
+ extern void caml_raise_exception (caml_domain_state* state, value bucket)
CAMLnoreturn_end;
-char * caml_exception_pointer = NULL;
-
+/* Used by the stack overflow handler -> deactivate ASAN (see
+ segv_handler in signals_nat.c). */
+CAMLno_asan
void caml_raise(value v)
{
Unlock_exn();
- if (caml_exception_pointer == NULL) caml_fatal_uncaught_exception(v);
+ if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
- while (caml_local_roots != NULL &&
- (char *) caml_local_roots < caml_exception_pointer) {
- caml_local_roots = caml_local_roots->next;
+ while (Caml_state->local_roots != NULL &&
+ (char *) Caml_state->local_roots < Caml_state->exception_pointer) {
+ Caml_state->local_roots = Caml_state->local_roots->next;
}
- caml_raise_exception(v);
+ caml_raise_exception(Caml_state, v);
}
+/* Used by the stack overflow handler -> deactivate ASAN (see
+ segv_handler in signals_nat.c). */
+CAMLno_asan
void caml_raise_constant(value tag)
{
caml_raise(tag);
caml_raise_constant((value) caml_exn_Out_of_memory);
}
+/* Used by the stack overflow handler -> deactivate ASAN (see
+ segv_handler in signals_nat.c). */
+CAMLno_asan
void caml_raise_stack_overflow(void)
{
caml_raise_constant((value) caml_exn_Stack_overflow);
caml_raise_constant((value) caml_exn_Sys_blocked_io);
}
+value caml_raise_if_exception(value res)
+{
+ if (Is_exception_result(res)) caml_raise(Extract_exception(res));
+ return res;
+}
+
/* We use a pre-allocated exception because we can't
do a GC before the exception is raised (lack of stack descriptors
for the ccall to [caml_array_bound_error]). */
It is the finalising set.
*/
+static int running_finalisation_function = 0;
/* [size] is a number of elements for the [to_do.item] array */
static void alloc_to_do (int size)
if (to_do_tl == NULL){
to_do_hd = result;
to_do_tl = result;
+ if(!running_finalisation_function) caml_set_action_pending();
}else{
CAMLassert (to_do_tl->next == NULL);
to_do_tl->next = result;
generic_final_update(&finalisable_last, /* darken_value */ 0);
}
-
-static int running_finalisation_function = 0;
-
/* Call the finalisation functions for the finalising set.
Note that this function must be reentrant.
*/
-void caml_final_do_calls (void)
+value caml_final_do_calls_exn (void)
{
struct final f;
value res;
void* saved_spacetime_trie_node_ptr;
#endif
- if (running_finalisation_function) return;
- if (to_do_hd != NULL){
+ if (!running_finalisation_function && to_do_hd != NULL){
if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
caml_gc_message (0x80, "Calling finalisation functions.\n");
while (1){
caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
#endif
running_finalisation_function = 0;
- if (Is_exception_result (res)) caml_raise (Extract_exception (res));
+ if (Is_exception_result (res)) return res;
}
caml_gc_message (0x80, "Done calling finalisation functions.\n");
if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
}
+ return Val_unit;
}
/* Call a scanning_action [f] on [x]. */
return Val_unit;
}
-
CAMLprim value caml_final_release (value unit)
{
running_finalisation_function = 0;
+ /* Some finalisers might be waiting. */
+ if (to_do_tl != NULL)
+ caml_set_action_pending();
return Val_unit;
}
code_t caml_start_code;
asize_t caml_code_size;
-unsigned char * caml_saved_code;
struct ext_table caml_code_fragments_table;
/* Read the main bytecode block from a file */
void caml_load_code(int fd, asize_t len)
{
- int i;
-
caml_code_size = len;
caml_start_code = (code_t) caml_stat_alloc(caml_code_size);
if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size)
#ifdef ARCH_BIG_ENDIAN
caml_fixup_endianness(caml_start_code, caml_code_size);
#endif
- if (caml_debugger_in_use) {
- len /= sizeof(opcode_t);
- caml_saved_code = (unsigned char *) caml_stat_alloc(len);
- for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i];
- }
#ifdef THREADED_CODE
- /* Better to thread now than at the beginning of [caml_interprete],
- since the debugger interface needs to perform SET_EVENT requests
- on the code. */
caml_thread_code(caml_start_code, caml_code_size);
#endif
}
#include <string.h>
#include "caml/config.h"
+#include "caml/custom.h"
#include "caml/freelist.h"
#include "caml/gc.h"
#include "caml/gc_ctrl.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
+/*************** declarations common to all policies ******************/
+
+/* A block in a small free list is a [value] (integer representing a
+ pointer to the first word after the block's header). The end of the
+ list is NULL.
+*/
+#define Val_NULL ((value) NULL)
+
+asize_t caml_fl_cur_wsz = 0; /* Number of words in the free set,
+ including headers but not fragments. */
+
+value caml_fl_merge = Val_NULL; /* Current insertion pointer. Managed
+ jointly with [sweep_slice]. */
+
+/* Next in list */
+#define Next_small(v) Field ((v), 0)
+
+/* Next in memory order */
+static inline value Next_in_mem (value v) {
+ return (value) &Field ((v), Whsize_val (v));
+}
+
+#ifdef CAML_INSTR
+static uintnat instr_size [20] =
+ {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
+static char *instr_name [20] = {
+ NULL,
+ "alloc01@",
+ "alloc02@",
+ "alloc03@",
+ "alloc04@",
+ "alloc05@",
+ "alloc06@",
+ "alloc07@",
+ "alloc08@",
+ "alloc09@",
+ "alloc10-19@",
+ "alloc20-29@",
+ "alloc30-39@",
+ "alloc40-49@",
+ "alloc50-59@",
+ "alloc60-69@",
+ "alloc70-79@",
+ "alloc80-89@",
+ "alloc90-99@",
+ "alloc_large@",
+};
+uintnat caml_instr_alloc_jump = 0;
+/* number of pointers followed to allocate from the free set */
+
+#define INSTR_alloc_jump(n) (caml_instr_alloc_jump += (n))
+
+#else
+
+#define INSTR_alloc_jump(n) ((void)0)
+
+#endif /*CAML_INSTR*/
+
+
+/********************* next-fit allocation policy *********************/
+
/* The free-list is kept sorted by increasing addresses.
This makes the merging of adjacent free blocks possible.
- (See [caml_fl_merge_block].)
+ (See [nf_merge_block].)
*/
-/* A free list block is a [value] (integer representing a pointer to the
- first word after the block's header). The end of the list is NULL. */
-#define Val_NULL ((value) NULL)
-
/* The sentinel can be located anywhere in memory, but it must not be
adjacent to any heap object. */
static struct {
header_t h;
value first_field;
value filler2; /* Make sure the sentinel is never adjacent to any block. */
-} sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0};
-
-#define Fl_head (Val_bp (&(sentinel.first_field)))
-static value fl_prev = Fl_head; /* Current allocation pointer. */
-static value fl_last = Val_NULL; /* Last block in the list. Only valid
- just after [caml_fl_allocate] returns NULL. */
-value caml_fl_merge = Fl_head; /* Current insertion pointer. Managed
- jointly with [sweep_slice]. */
-asize_t caml_fl_cur_wsz = 0; /* Number of words in the free list,
- including headers but not fragments. */
-
-#define FLP_MAX 1000
-static value flp [FLP_MAX];
-static int flp_size = 0;
-static value beyond = Val_NULL;
+} nf_sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0};
-#define Next(b) (Field (b, 0))
+#define Nf_head (Val_bp (&(nf_sentinel.first_field)))
-#define Policy_next_fit 0
-#define Policy_first_fit 1
-uintnat caml_allocation_policy = Policy_next_fit;
-#define policy caml_allocation_policy
+static value nf_prev = Nf_head; /* Current allocation pointer. */
+static value nf_last = Val_NULL; /* Last block in the list. Only valid
+ just after [nf_allocate] returns NULL. */
-#ifdef DEBUG
-static void fl_check (void)
+#if defined (DEBUG) || FREELIST_DEBUG
+static void nf_check (void)
{
- value cur, prev;
- int prev_found = 0, flp_found = 0, merge_found = 0;
+ value cur;
+ int prev_found = 0, merge_found = 0;
uintnat size_found = 0;
- int sz = 0;
- prev = Fl_head;
- cur = Next (prev);
+ cur = Next_small (Nf_head);
while (cur != Val_NULL){
size_found += Whsize_bp (cur);
CAMLassert (Is_in_heap (cur));
- if (cur == fl_prev) prev_found = 1;
- if (policy == Policy_first_fit && Wosize_bp (cur) > sz){
- sz = Wosize_bp (cur);
- if (flp_found < flp_size){
- CAMLassert (Next (flp[flp_found]) == cur);
- ++ flp_found;
- }else{
- CAMLassert (beyond == Val_NULL
- || Bp_val (cur) >= Bp_val (Next (beyond)));
- }
- }
+ if (cur == nf_prev) prev_found = 1;
if (cur == caml_fl_merge) merge_found = 1;
- prev = cur;
- cur = Next (prev);
+ cur = Next_small (cur);
}
- if (policy == Policy_next_fit) CAMLassert (prev_found || fl_prev == Fl_head);
- if (policy == Policy_first_fit) CAMLassert (flp_found == flp_size);
- CAMLassert (merge_found || caml_fl_merge == Fl_head);
+ CAMLassert (prev_found || nf_prev == Nf_head);
+ CAMLassert (merge_found || caml_fl_merge == Nf_head);
CAMLassert (size_found == caml_fl_cur_wsz);
}
-#endif
+#endif /* DEBUG || FREELIST_DEBUG */
-/* [allocate_block] is called by [caml_fl_allocate]. Given a suitable free
+/* [nf_allocate_block] is called by [nf_allocate]. Given a suitable free
block and the requested size, it allocates a new block from the free
block. There are three cases:
0. The free block has the requested size. Detach the block from the
it is located in the high-address words of the free block, so that
the linking of the free-list does not change in case 2.
*/
-static header_t *allocate_block (mlsize_t wh_sz, int flpi, value prev,
- value cur)
+static header_t *nf_allocate_block (mlsize_t wh_sz, value prev, value cur)
{
header_t h = Hd_bp (cur);
CAMLassert (Whsize_hd (h) >= wh_sz);
if (Wosize_hd (h) < wh_sz + 1){ /* Cases 0 and 1. */
caml_fl_cur_wsz -= Whsize_hd (h);
- Next (prev) = Next (cur);
- CAMLassert (Is_in_heap (Next (prev)) || Next (prev) == Val_NULL);
+ Next_small (prev) = Next_small (cur);
+ CAMLassert (Is_in_heap (Next_small (prev))
+ || Next_small (prev) == Val_NULL);
if (caml_fl_merge == cur) caml_fl_merge = prev;
#ifdef DEBUG
- fl_last = Val_NULL;
+ nf_last = Val_NULL;
#endif
/* In case 1, the following creates the empty block correctly.
In case 0, it gives an invalid header to the block. The function
- calling [caml_fl_allocate] will overwrite it. */
+ calling [nf_allocate] will overwrite it. */
Hd_op (cur) = Make_header (0, 0, Caml_white);
- if (policy == Policy_first_fit){
- if (flpi + 1 < flp_size && flp[flpi + 1] == cur){
- flp[flpi + 1] = prev;
- }else if (flpi == flp_size - 1){
- beyond = (prev == Fl_head) ? Val_NULL : prev;
- -- flp_size;
- }
- }
}else{ /* Case 2. */
caml_fl_cur_wsz -= wh_sz;
Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
}
- if (policy == Policy_next_fit) fl_prev = prev;
+ nf_prev = prev;
return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz);
}
-#ifdef CAML_INSTR
-static uintnat instr_size [20] =
- {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
-static char *instr_name [20] = {
- NULL,
- "alloc01@",
- "alloc02@",
- "alloc03@",
- "alloc04@",
- "alloc05@",
- "alloc06@",
- "alloc07@",
- "alloc08@",
- "alloc09@",
- "alloc10-19@",
- "alloc20-29@",
- "alloc30-39@",
- "alloc40-49@",
- "alloc50-59@",
- "alloc60-69@",
- "alloc70-79@",
- "alloc80-89@",
- "alloc90-99@",
- "alloc_large@",
-};
-uintnat caml_instr_alloc_jump = 0;
-/* number of pointers followed to allocate from the free list */
-#endif /*CAML_INSTR*/
-
-/* [caml_fl_allocate] does not set the header of the newly allocated block.
- The calling function must do it before any GC function gets called.
- [caml_fl_allocate] returns a head pointer.
-*/
-header_t *caml_fl_allocate (mlsize_t wo_sz)
+static header_t *nf_allocate (mlsize_t wo_sz)
{
value cur = Val_NULL, prev;
- header_t *result;
- int i;
- mlsize_t sz, prevsz;
CAMLassert (sizeof (char *) == sizeof (value));
CAMLassert (wo_sz >= 1);
#ifdef CAML_INSTR
}
#endif /* CAML_INSTR */
- switch (policy){
- case Policy_next_fit:
- CAMLassert (fl_prev != Val_NULL);
- /* Search from [fl_prev] to the end of the list. */
- prev = fl_prev;
- cur = Next (prev);
+ CAMLassert (nf_prev != Val_NULL);
+ /* Search from [nf_prev] to the end of the list. */
+ prev = nf_prev;
+ cur = Next_small (prev);
while (cur != Val_NULL){
CAMLassert (Is_in_heap (cur));
if (Wosize_bp (cur) >= wo_sz){
- return allocate_block (Whsize_wosize (wo_sz), 0, prev, cur);
+ return nf_allocate_block (Whsize_wosize (wo_sz), prev, cur);
}
prev = cur;
- cur = Next (prev);
+ cur = Next_small (prev);
#ifdef CAML_INSTR
++ caml_instr_alloc_jump;
#endif
}
- fl_last = prev;
- /* Search from the start of the list to [fl_prev]. */
- prev = Fl_head;
- cur = Next (prev);
- while (prev != fl_prev){
+ nf_last = prev;
+ /* Search from the start of the list to [nf_prev]. */
+ prev = Nf_head;
+ cur = Next_small (prev);
+ while (prev != nf_prev){
if (Wosize_bp (cur) >= wo_sz){
- return allocate_block (Whsize_wosize (wo_sz), 0, prev, cur);
+ return nf_allocate_block (Whsize_wosize (wo_sz), prev, cur);
}
prev = cur;
- cur = Next (prev);
+ cur = Next_small (prev);
#ifdef CAML_INSTR
++ caml_instr_alloc_jump;
#endif
}
/* No suitable block was found. */
return NULL;
- break;
-
- case Policy_first_fit: {
- /* Search in the flp array. */
- for (i = 0; i < flp_size; i++){
- sz = Wosize_bp (Next (flp[i]));
- if (sz >= wo_sz){
-#if FREELIST_DEBUG
- if (i > 5) fprintf (stderr, "FLP: found at %d size=%d\n", i, wo_sz);
-#endif
- result = allocate_block (Whsize_wosize (wo_sz), i, flp[i],
- Next (flp[i]));
- goto update_flp;
- }
- }
- /* Extend the flp array. */
- if (flp_size == 0){
- prev = Fl_head;
- prevsz = 0;
- }else{
- prev = Next (flp[flp_size - 1]);
- prevsz = Wosize_bp (prev);
- if (beyond != Val_NULL) prev = beyond;
- }
- while (flp_size < FLP_MAX){
- cur = Next (prev);
- if (cur == Val_NULL){
- fl_last = prev;
- beyond = (prev == Fl_head) ? Val_NULL : prev;
- return NULL;
- }else{
- sz = Wosize_bp (cur);
- if (sz > prevsz){
- flp[flp_size] = prev;
- ++ flp_size;
- if (sz >= wo_sz){
- beyond = cur;
- i = flp_size - 1;
-#if FREELIST_DEBUG
- if (flp_size > 5){
- fprintf (stderr, "FLP: extended to %d\n", flp_size);
- }
-#endif
- result = allocate_block (Whsize_wosize (wo_sz), flp_size - 1, prev,
- cur);
- goto update_flp;
- }
- prevsz = sz;
- }
- }
- prev = cur;
- }
- beyond = cur;
-
- /* The flp table is full. Do a slow first-fit search. */
-#if FREELIST_DEBUG
- fprintf (stderr, "FLP: table is full -- slow first-fit\n");
-#endif
- if (beyond != Val_NULL){
- prev = beyond;
- }else{
- prev = flp[flp_size - 1];
- }
- prevsz = Wosize_bp (Next (flp[FLP_MAX-1]));
- CAMLassert (prevsz < wo_sz);
- cur = Next (prev);
- while (cur != Val_NULL){
- CAMLassert (Is_in_heap (cur));
- sz = Wosize_bp (cur);
- if (sz < prevsz){
- beyond = cur;
- }else if (sz >= wo_sz){
- return allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur);
- }
- prev = cur;
- cur = Next (prev);
- }
- fl_last = prev;
- return NULL;
-
- update_flp: /* (i, sz) */
- /* The block at [i] was removed or reduced. Update the table. */
- CAMLassert (0 <= i && i < flp_size + 1);
- if (i < flp_size){
- if (i > 0){
- prevsz = Wosize_bp (Next (flp[i-1]));
- }else{
- prevsz = 0;
- }
- if (i == flp_size - 1){
- if (Wosize_bp (Next (flp[i])) <= prevsz){
- beyond = Next (flp[i]);
- -- flp_size;
- }else{
- beyond = Val_NULL;
- }
- }else{
- value buf [FLP_MAX];
- int j = 0;
- mlsize_t oldsz = sz;
-
- prev = flp[i];
- while (prev != flp[i+1] && j < FLP_MAX - i){
- cur = Next (prev);
- sz = Wosize_bp (cur);
- if (sz > prevsz){
- buf[j++] = prev;
- prevsz = sz;
- if (sz >= oldsz){
- CAMLassert (sz == oldsz);
- break;
- }
- }
- prev = cur;
- }
-#if FREELIST_DEBUG
- if (j > 2) fprintf (stderr, "FLP: update; buf size = %d\n", j);
-#endif
- if (FLP_MAX >= flp_size + j - 1){
- if (j != 1){
- memmove (&flp[i+j], &flp[i+1], sizeof (value) * (flp_size-i-1));
- }
- if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j);
- flp_size += j - 1;
- }else{
- if (FLP_MAX > i + j){
- if (j != 1){
- memmove (&flp[i+j], &flp[i+1], sizeof (value) * (FLP_MAX-i-j));
- }
- if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j);
- }else{
- if (i != FLP_MAX){
- memmove (&flp[i], &buf[0], sizeof (value) * (FLP_MAX - i));
- }
- }
- flp_size = FLP_MAX - 1;
- beyond = Next (flp[FLP_MAX - 1]);
- }
- }
- }
- return result;
- }
- break;
-
- default:
- CAMLassert (0); /* unknown policy */
- break;
- }
- return NULL; /* NOT REACHED */
}
/* Location of the last fragment seen by the sweeping code.
Note that [last_fragment] doesn't point to the fragment itself,
but to the block after it.
*/
-static header_t *last_fragment;
+static header_t *nf_last_fragment;
-void caml_fl_init_merge (void)
+static void nf_init_merge (void)
{
#ifdef CAML_INSTR
int i;
instr_size[i] = 0;
}
#endif /* CAML_INSTR */
- last_fragment = NULL;
- caml_fl_merge = Fl_head;
+ nf_last_fragment = NULL;
+ caml_fl_merge = Nf_head;
#ifdef DEBUG
- fl_check ();
+ nf_check ();
#endif
}
-static void truncate_flp (value changed)
-{
- if (changed == Fl_head){
- flp_size = 0;
- beyond = Val_NULL;
- }else{
- while (flp_size > 0
- && Bp_val (Next (flp[flp_size - 1])) >= Bp_val (changed))
- -- flp_size;
- if (Bp_val (beyond) >= Bp_val (changed)) beyond = Val_NULL;
- }
-}
-
-/* This is called by caml_compact_heap. */
-void caml_fl_reset (void)
+static void nf_reset (void)
{
- Next (Fl_head) = Val_NULL;
- switch (policy){
- case Policy_next_fit:
- fl_prev = Fl_head;
- break;
- case Policy_first_fit:
- truncate_flp (Fl_head);
- break;
- default:
- CAMLassert (0);
- break;
- }
+ Next_small (Nf_head) = Val_NULL;
+ nf_prev = Nf_head;
caml_fl_cur_wsz = 0;
- caml_fl_init_merge ();
+ nf_init_merge ();
}
-/* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
- because merging blocks may change the size of [bp]. */
-header_t *caml_fl_merge_block (value bp)
+/* Note: the [limit] parameter is unused because we merge blocks one by one. */
+static header_t *nf_merge_block (value bp, char *limit)
{
- value prev, cur;
- header_t *adj;
+ value prev, cur, adj;
header_t hd = Hd_val (bp);
mlsize_t prev_wosz;
caml_fl_cur_wsz += Whsize_hd (hd);
+ /* [merge_block] is now responsible for calling the finalization function. */
+ if (Tag_hd (hd) == Custom_tag){
+ void (*final_fun)(value) = Custom_ops_val(bp)->finalize;
+ if (final_fun != NULL) final_fun(bp);
+ }
+
#ifdef DEBUG
caml_set_fields (bp, 0, Debug_free_major);
#endif
prev = caml_fl_merge;
- cur = Next (prev);
+ cur = Next_small (prev);
/* The sweep code makes sure that this is the right place to insert
this block: */
- CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Fl_head);
+ CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head);
CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
- if (policy == Policy_first_fit) truncate_flp (prev);
-
/* If [last_fragment] and [bp] are adjacent, merge them. */
- if (last_fragment == Hp_val (bp)){
+ if (nf_last_fragment == Hp_val (bp)){
mlsize_t bp_whsz = Whsize_val (bp);
if (bp_whsz <= Max_wosize){
hd = Make_header (bp_whsz, 0, Caml_white);
- bp = (value) last_fragment;
+ bp = (value) nf_last_fragment;
Hd_val (bp) = hd;
caml_fl_cur_wsz += Whsize_wosize (0);
}
/* If [bp] and [cur] are adjacent, remove [cur] from the free-list
and merge them. */
- adj = (header_t *) &Field (bp, Wosize_hd (hd));
- if (adj == Hp_val (cur)){
- value next_cur = Next (cur);
+ adj = Next_in_mem (bp);
+ if (adj == cur){
+ value next_cur = Next_small (cur);
mlsize_t cur_whsz = Whsize_val (cur);
if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
- Next (prev) = next_cur;
- if (policy == Policy_next_fit && fl_prev == cur) fl_prev = prev;
+ Next_small (prev) = next_cur;
+ if (nf_prev == cur) nf_prev = prev;
hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
Hd_val (bp) = hd;
- adj = (header_t *) &Field (bp, Wosize_hd (hd));
+ adj = Next_in_mem (bp);
#ifdef DEBUG
- fl_last = Val_NULL;
- Next (cur) = (value) Debug_free_major;
+ nf_last = Val_NULL;
+ Next_small (cur) = (value) Debug_free_major;
Hd_val (cur) = Debug_free_major;
#endif
cur = next_cur;
/* If [prev] and [bp] are adjacent merge them, else insert [bp] into
the free-list if it is big enough. */
prev_wosz = Wosize_val (prev);
- if ((header_t *) &Field (prev, prev_wosz) == Hp_val (bp)
- && prev_wosz + Whsize_hd (hd) < Max_wosize){
- Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0,Caml_blue);
+ if (Next_in_mem (prev) == bp && prev_wosz + Whsize_hd (hd) < Max_wosize){
+ Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0, Caml_blue);
#ifdef DEBUG
Hd_val (bp) = Debug_free_major;
#endif
CAMLassert (caml_fl_merge == prev);
}else if (Wosize_hd (hd) != 0){
Hd_val (bp) = Bluehd_hd (hd);
- Next (bp) = cur;
- Next (prev) = bp;
+ Next_small (bp) = cur;
+ Next_small (prev) = bp;
caml_fl_merge = bp;
}else{
/* This is a fragment. Leave it in white but remember it for eventual
merging with the next block. */
- last_fragment = (header_t *) bp;
+ nf_last_fragment = (header_t *) bp;
caml_fl_cur_wsz -= Whsize_wosize (0);
}
- return adj;
+ return Hp_val (adj);
}
/* This is a heap extension. We have to insert it in the right place
in the free-list.
- [caml_fl_add_blocks] can only be called right after a call to
- [caml_fl_allocate] that returned Val_NULL.
+ [nf_add_blocks] can only be called right after a call to
+ [nf_allocate] that returned Val_NULL.
Most of the heap extensions are expected to be at the end of the
free list. (This depends on the implementation of [malloc].)
terminated by Val_NULL, and field 1 of the first block must point to
the last block.
*/
-void caml_fl_add_blocks (value bp)
+static void nf_add_blocks (value bp)
{
value cur = bp;
- CAMLassert (fl_last != Val_NULL);
- CAMLassert (Next (fl_last) == Val_NULL);
+ CAMLassert (nf_last != Val_NULL);
+ CAMLassert (Next_small (nf_last) == Val_NULL);
do {
caml_fl_cur_wsz += Whsize_bp (cur);
cur = Field(cur, 0);
} while (cur != Val_NULL);
- if (Bp_val (bp) > Bp_val (fl_last)){
- Next (fl_last) = bp;
- if (fl_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+ if (Bp_val (bp) > Bp_val (nf_last)){
+ Next_small (nf_last) = bp;
+ if (nf_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
caml_fl_merge = Field (bp, 1);
}
- if (policy == Policy_first_fit && flp_size < FLP_MAX){
- flp [flp_size++] = fl_last;
- }
}else{
value prev;
- prev = Fl_head;
- cur = Next (prev);
+ prev = Nf_head;
+ cur = Next_small (prev);
while (cur != Val_NULL && Bp_val (cur) < Bp_val (bp)){
- CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Fl_head);
- /* XXX TODO: extend flp on the fly */
+ CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head);
prev = cur;
- cur = Next (prev);
+ cur = Next_small (prev);
}
- CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Fl_head);
+ CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head);
CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
- Next (Field (bp, 1)) = cur;
- Next (prev) = bp;
+ Next_small (Field (bp, 1)) = cur;
+ Next_small (prev) = bp;
/* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp],
we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge]
is always the last free-list block before [caml_gc_sweep_hp]. */
if (prev == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
caml_fl_merge = Field (bp, 1);
}
- if (policy == Policy_first_fit) truncate_flp (bp);
}
}
-/* Cut a block of memory into Max_wosize pieces, give them headers,
- and optionally merge them into the free list.
- arguments:
- p: pointer to the first word of the block
- size: size of the block (in words)
- do_merge: 1 -> do merge; 0 -> do not merge
- color: which color to give to the pieces; if [do_merge] is 1, this
- is overridden by the merge code, but we have historically used
- [Caml_white].
-*/
-void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color)
+static void nf_make_free_blocks
+ (value *p, mlsize_t size, int do_merge, int color)
{
mlsize_t sz;
}else{
sz = size;
}
- *(header_t *)p =
- Make_header (Wosize_whsize (sz), 0, color);
- if (do_merge) caml_fl_merge_block (Val_hp (p));
+ *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color);
+ if (do_merge) nf_merge_block (Val_hp (p), NULL);
size -= sz;
p += sz;
}
}
-void caml_set_allocation_policy (uintnat p)
-{
+/******************** first-fit allocation policy *********************/
+
+#define FLP_MAX 1000
+static value flp [FLP_MAX];
+static int flp_size = 0;
+static value beyond = Val_NULL;
+
+/* The sentinel can be located anywhere in memory, but it must not be
+ adjacent to any heap object. */
+static struct {
+ value filler1; /* Make sure the sentinel is never adjacent to any block. */
+ header_t h;
+ value first_field;
+ value filler2; /* Make sure the sentinel is never adjacent to any block. */
+} ff_sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0};
+
+#define Ff_head (Val_bp (&(ff_sentinel.first_field)))
+static value ff_last = Val_NULL; /* Last block in the list. Only valid
+ just after [ff_allocate] returns NULL. */
+
+
+#if defined (DEBUG) || FREELIST_DEBUG
+static void ff_check (void)
+{
+ value cur;
+ int flp_found = 0, merge_found = 0;
+ uintnat size_found = 0;
+ int sz = 0;
+
+ cur = Next_small (Ff_head);
+ while (cur != Val_NULL){
+ size_found += Whsize_bp (cur);
+ CAMLassert (Is_in_heap (cur));
+ if (Wosize_bp (cur) > sz){
+ sz = Wosize_bp (cur);
+ if (flp_found < flp_size){
+ CAMLassert (Next_small (flp[flp_found]) == cur);
+ ++ flp_found;
+ }else{
+ CAMLassert (beyond == Val_NULL
+ || Bp_val (cur) >= Bp_val (Next_small (beyond)));
+ }
+ }
+ if (cur == caml_fl_merge) merge_found = 1;
+ cur = Next_small (cur);
+ }
+ CAMLassert (flp_found == flp_size);
+ CAMLassert (merge_found || caml_fl_merge == Ff_head);
+ CAMLassert (size_found == caml_fl_cur_wsz);
+}
+#endif /* DEBUG || FREELIST_DEBUG */
+
+/* [ff_allocate_block] is called by [ff_allocate]. Given a suitable free
+ block and the requested size, it allocates a new block from the free
+ block. There are three cases:
+ 0. The free block has the requested size. Detach the block from the
+ free-list and return it.
+ 1. The free block is 1 word longer than the requested size. Detach
+ the block from the free list. The remaining word cannot be linked:
+ turn it into an empty block (header only), and return the rest.
+ 2. The free block is large enough. Split it in two and return the right
+ block.
+ In all cases, the allocated block is right-justified in the free block:
+ it is located in the high-address words of the free block, so that
+ the linking of the free-list does not change in case 2.
+*/
+static header_t *ff_allocate_block (mlsize_t wh_sz, int flpi, value prev,
+ value cur)
+{
+ header_t h = Hd_bp (cur);
+ CAMLassert (Whsize_hd (h) >= wh_sz);
+ if (Wosize_hd (h) < wh_sz + 1){ /* Cases 0 and 1. */
+ caml_fl_cur_wsz -= Whsize_hd (h);
+ Next_small (prev) = Next_small (cur);
+ CAMLassert (Is_in_heap (Next_small (prev))
+ || Next_small (prev) == Val_NULL);
+ if (caml_fl_merge == cur) caml_fl_merge = prev;
+#ifdef DEBUG
+ ff_last = Val_NULL;
+#endif
+ /* In case 1, the following creates the empty block correctly.
+ In case 0, it gives an invalid header to the block. The function
+ calling [ff_allocate] will overwrite it. */
+ Hd_op (cur) = Make_header (0, 0, Caml_white);
+ if (flpi + 1 < flp_size && flp[flpi + 1] == cur){
+ flp[flpi + 1] = prev;
+ }else if (flpi == flp_size - 1){
+ beyond = (prev == Ff_head) ? Val_NULL : prev;
+ -- flp_size;
+ }
+ }else{ /* Case 2. */
+ caml_fl_cur_wsz -= wh_sz;
+ Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
+ }
+ return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz);
+}
+
+static header_t *ff_allocate (mlsize_t wo_sz)
+{
+ value cur = Val_NULL, prev;
+ header_t *result;
+ int i;
+ mlsize_t sz, prevsz;
+ CAMLassert (sizeof (char *) == sizeof (value));
+ CAMLassert (wo_sz >= 1);
+#ifdef CAML_INSTR
+ if (wo_sz < 10){
+ ++instr_size[wo_sz];
+ }else if (wo_sz < 100){
+ ++instr_size[wo_sz/10 + 9];
+ }else{
+ ++instr_size[19];
+ }
+#endif /* CAML_INSTR */
+
+ /* Search in the flp array. */
+ for (i = 0; i < flp_size; i++){
+ sz = Wosize_bp (Next_small (flp[i]));
+ if (sz >= wo_sz){
+#if FREELIST_DEBUG
+ if (i > 5) fprintf (stderr, "FLP: found at %d size=%d\n", i, wo_sz);
+#endif
+ result = ff_allocate_block (Whsize_wosize (wo_sz), i, flp[i],
+ Next_small (flp[i]));
+ goto update_flp;
+ }
+ }
+ /* Extend the flp array. */
+ if (flp_size == 0){
+ prev = Ff_head;
+ prevsz = 0;
+ }else{
+ prev = Next_small (flp[flp_size - 1]);
+ prevsz = Wosize_bp (prev);
+ if (beyond != Val_NULL) prev = beyond;
+ }
+ while (flp_size < FLP_MAX){
+ cur = Next_small (prev);
+ if (cur == Val_NULL){
+ ff_last = prev;
+ beyond = (prev == Ff_head) ? Val_NULL : prev;
+ return NULL;
+ }else{
+ sz = Wosize_bp (cur);
+ if (sz > prevsz){
+ flp[flp_size] = prev;
+ ++ flp_size;
+ if (sz >= wo_sz){
+ beyond = cur;
+ i = flp_size - 1;
+#if FREELIST_DEBUG
+ if (flp_size > 5){
+ fprintf (stderr, "FLP: extended to %d\n", flp_size);
+ }
+#endif
+ result = ff_allocate_block (Whsize_wosize (wo_sz), flp_size - 1,
+ prev, cur);
+ goto update_flp;
+ }
+ prevsz = sz;
+ }
+ }
+ prev = cur;
+ }
+ beyond = cur;
+
+ /* The flp table is full. Do a slow first-fit search. */
+#if FREELIST_DEBUG
+ fprintf (stderr, "FLP: table is full -- slow first-fit\n");
+#endif
+ if (beyond != Val_NULL){
+ prev = beyond;
+ }else{
+ prev = flp[flp_size - 1];
+ }
+ prevsz = Wosize_bp (Next_small (flp[FLP_MAX-1]));
+ CAMLassert (prevsz < wo_sz);
+ cur = Next_small (prev);
+ while (cur != Val_NULL){
+ CAMLassert (Is_in_heap (cur));
+ sz = Wosize_bp (cur);
+ if (sz < prevsz){
+ beyond = cur;
+ }else if (sz >= wo_sz){
+ return ff_allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur);
+ }
+ prev = cur;
+ cur = Next_small (prev);
+ }
+ ff_last = prev;
+ return NULL;
+
+ update_flp: /* (i, sz) */
+ /* The block at [i] was removed or reduced. Update the table. */
+ CAMLassert (0 <= i && i < flp_size + 1);
+ if (i < flp_size){
+ if (i > 0){
+ prevsz = Wosize_bp (Next_small (flp[i-1]));
+ }else{
+ prevsz = 0;
+ }
+ if (i == flp_size - 1){
+ if (Wosize_bp (Next_small (flp[i])) <= prevsz){
+ beyond = Next_small (flp[i]);
+ -- flp_size;
+ }else{
+ beyond = Val_NULL;
+ }
+ }else{
+ value buf [FLP_MAX];
+ int j = 0;
+ mlsize_t oldsz = sz;
+
+ prev = flp[i];
+ while (prev != flp[i+1] && j < FLP_MAX - i){
+ cur = Next_small (prev);
+ sz = Wosize_bp (cur);
+ if (sz > prevsz){
+ buf[j++] = prev;
+ prevsz = sz;
+ if (sz >= oldsz){
+ CAMLassert (sz == oldsz);
+ break;
+ }
+ }
+ prev = cur;
+ }
+#if FREELIST_DEBUG
+ if (j > 2) fprintf (stderr, "FLP: update; buf size = %d\n", j);
+#endif
+ if (FLP_MAX >= flp_size + j - 1){
+ if (j != 1){
+ memmove (&flp[i+j], &flp[i+1], sizeof (value) * (flp_size-i-1));
+ }
+ if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j);
+ flp_size += j - 1;
+ }else{
+ if (FLP_MAX > i + j){
+ if (j != 1){
+ memmove (&flp[i+j], &flp[i+1], sizeof (value) * (FLP_MAX-i-j));
+ }
+ if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j);
+ }else{
+ if (i != FLP_MAX){
+ memmove (&flp[i], &buf[0], sizeof (value) * (FLP_MAX - i));
+ }
+ }
+ flp_size = FLP_MAX - 1;
+ beyond = Next_small (flp[FLP_MAX - 1]);
+ }
+ }
+ }
+ return result;
+}
+
+/* Location of the last fragment seen by the sweeping code.
+ This is a pointer to the first word after the fragment, which is
+ the header of the next block.
+ Note that [ff_last_fragment] doesn't point to the fragment itself,
+ but to the block after it.
+*/
+static header_t *ff_last_fragment;
+
+static void ff_init_merge (void)
+{
+#ifdef CAML_INSTR
+ int i;
+ for (i = 1; i < 20; i++){
+ CAML_INSTR_INT (instr_name[i], instr_size[i]);
+ instr_size[i] = 0;
+ }
+#endif /* CAML_INSTR */
+ ff_last_fragment = NULL;
+ caml_fl_merge = Ff_head;
+#ifdef DEBUG
+ ff_check ();
+#endif
+}
+
+static void ff_truncate_flp (value changed)
+{
+ if (changed == Ff_head){
+ flp_size = 0;
+ beyond = Val_NULL;
+ }else{
+ while (flp_size > 0 &&
+ Bp_val (Next_small (flp[flp_size - 1])) >= Bp_val (changed))
+ -- flp_size;
+ if (Bp_val (beyond) >= Bp_val (changed)) beyond = Val_NULL;
+ }
+}
+
+static void ff_reset (void)
+{
+ Next_small (Ff_head) = Val_NULL;
+ ff_truncate_flp (Ff_head);
+ caml_fl_cur_wsz = 0;
+ ff_init_merge ();
+}
+
+/* Note: the [limit] parameter is unused because we merge blocks one by one. */
+static header_t *ff_merge_block (value bp, char *limit)
+{
+ value prev, cur, adj;
+ header_t hd = Hd_val (bp);
+ mlsize_t prev_wosz;
+
+ caml_fl_cur_wsz += Whsize_hd (hd);
+
+ /* [merge_block] is now responsible for calling the finalization function. */
+ if (Tag_hd (hd) == Custom_tag){
+ void (*final_fun)(value) = Custom_ops_val(bp)->finalize;
+ if (final_fun != NULL) final_fun(bp);
+ }
+
+#ifdef DEBUG
+ caml_set_fields (bp, 0, Debug_free_major);
+#endif
+ prev = caml_fl_merge;
+ cur = Next_small (prev);
+ /* The sweep code makes sure that this is the right place to insert
+ this block: */
+ CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head);
+ CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
+
+ ff_truncate_flp (prev);
+
+ /* If [ff_last_fragment] and [bp] are adjacent, merge them. */
+ if (ff_last_fragment == Hp_bp (bp)){
+ mlsize_t bp_whsz = Whsize_val (bp);
+ if (bp_whsz <= Max_wosize){
+ hd = Make_header (bp_whsz, 0, Caml_white);
+ bp = (value) ff_last_fragment;
+ Hd_val (bp) = hd;
+ caml_fl_cur_wsz += Whsize_wosize (0);
+ }
+ }
+
+ /* If [bp] and [cur] are adjacent, remove [cur] from the free-list
+ and merge them. */
+ adj = Next_in_mem (bp);
+ if (adj == cur){
+ value next_cur = Next_small (cur);
+ mlsize_t cur_whsz = Whsize_val (cur);
+
+ if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
+ Next_small (prev) = next_cur;
+ hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
+ Hd_val (bp) = hd;
+ adj = Next_in_mem (bp);
+#ifdef DEBUG
+ ff_last = Val_NULL;
+ Next_small (cur) = (value) Debug_free_major;
+ Hd_val (cur) = Debug_free_major;
+#endif
+ cur = next_cur;
+ }
+ }
+ /* If [prev] and [bp] are adjacent merge them, else insert [bp] into
+ the free-list if it is big enough. */
+ prev_wosz = Wosize_val (prev);
+ if (Next_in_mem (prev) == bp && prev_wosz + Whsize_hd (hd) < Max_wosize){
+ Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0, Caml_blue);
+#ifdef DEBUG
+ Hd_val (bp) = Debug_free_major;
+#endif
+ CAMLassert (caml_fl_merge == prev);
+ }else if (Wosize_hd (hd) != 0){
+ Hd_val (bp) = Bluehd_hd (hd);
+ Next_small (bp) = cur;
+ Next_small (prev) = bp;
+ caml_fl_merge = bp;
+ }else{
+ /* This is a fragment. Leave it in white but remember it for eventual
+ merging with the next block. */
+ ff_last_fragment = (header_t *) bp;
+ caml_fl_cur_wsz -= Whsize_wosize (0);
+ }
+ return Hp_val (adj);
+}
+
+/* This is a heap extension. We have to insert it in the right place
+ in the free-list.
+ [ff_add_blocks] can only be called right after a call to
+ [ff_allocate] that returned Val_NULL.
+ Most of the heap extensions are expected to be at the end of the
+ free list. (This depends on the implementation of [malloc].)
+
+ [bp] must point to a list of blocks chained by their field 0,
+ terminated by Val_NULL, and field 1 of the first block must point to
+ the last block.
+*/
+static void ff_add_blocks (value bp)
+{
+ value cur = bp;
+ CAMLassert (ff_last != Val_NULL);
+ CAMLassert (Next_small (ff_last) == Val_NULL);
+ do {
+ caml_fl_cur_wsz += Whsize_bp (cur);
+ cur = Field(cur, 0);
+ } while (cur != Val_NULL);
+
+ if (Bp_val (bp) > Bp_val (ff_last)){
+ Next_small (ff_last) = bp;
+ if (ff_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+ caml_fl_merge = Field (bp, 1);
+ }
+ if (flp_size < FLP_MAX){
+ flp [flp_size++] = ff_last;
+ }
+ }else{
+ value prev;
+
+ prev = Ff_head;
+ cur = Next_small (prev);
+ while (cur != Val_NULL && Bp_val (cur) < Bp_val (bp)){
+ CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head);
+ /* XXX TODO: extend flp on the fly */
+ prev = cur;
+ cur = Next_small (prev);
+ }
+ CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head);
+ CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
+ Next_small (Field (bp, 1)) = cur;
+ Next_small (prev) = bp;
+ /* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp],
+ we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge]
+ is always the last free-list block before [caml_gc_sweep_hp]. */
+ if (prev == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+ caml_fl_merge = Field (bp, 1);
+ }
+ ff_truncate_flp (bp);
+ }
+}
+
+static void ff_make_free_blocks
+ (value *p, mlsize_t size, int do_merge, int color)
+{
+ mlsize_t sz;
+
+ while (size > 0){
+ if (size > Whsize_wosize (Max_wosize)){
+ sz = Whsize_wosize (Max_wosize);
+ }else{
+ sz = size;
+ }
+ *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color);
+ if (do_merge) ff_merge_block (Val_hp (p), NULL);
+ size -= sz;
+ p += sz;
+ }
+}
+
+/********************* best-fit allocation policy *********************/
+
+/* quick-fit + FIFO-ordered best fit (Wilson's nomenclature)
+ We use Standish's data structure (a tree of doubly-linked lists)
+ with a splay tree (Sleator & Tarjan).
+*/
+
+/* [BF_NUM_SMALL] must be at least 4 for this code to work
+ and at least 5 for good performance on typical OCaml programs.
+ For portability reasons, BF_NUM_SMALL cannot be more than 32.
+*/
+#define BF_NUM_SMALL 16
+
+/* Note that indexing into [bf_small_fl] starts at 1, so the first entry
+ in this array is unused.
+*/
+static struct {
+ value free;
+ value *merge;
+} bf_small_fl [BF_NUM_SMALL + 1];
+static int bf_small_map = 0;
+
+/* Small free blocks have only one pointer to the next block.
+ Large free blocks have 5 fields:
+ tree fields:
+ - node flag
+ - left son
+ - right son
+ list fields:
+ - next
+ - prev
+*/
+typedef struct large_free_block {
+ int isnode;
+ struct large_free_block *left;
+ struct large_free_block *right;
+ struct large_free_block *prev;
+ struct large_free_block *next;
+} large_free_block;
+
+static inline mlsize_t bf_large_wosize (struct large_free_block *n) {
+ return Wosize_val((value)(n));
+}
+
+static struct large_free_block *bf_large_tree;
+static struct large_free_block *bf_large_least;
+/* [bf_large_least] is either NULL or a pointer to the smallest (leftmost)
+ block in the tree. In this latter case, the block must be alone in its
+ doubly-linked list (i.e. have [isnode] true and [prev] and [next]
+ both pointing back to this block)
+*/
+
+/* Auxiliary functions for bitmap */
+
+/* Find first (i.e. least significant) bit set in a word. */
+#ifdef HAS_FFS
+#include <strings.h>
+#elif defined(HAS_BITSCANFORWARD)
+#include <intrin.h>
+static inline int ffs (int x)
+{
+ unsigned long index;
+ unsigned char result;
+ result = _BitScanForward (&index, (unsigned long) x);
+ return result ? (int) index + 1 : 0;
+}
+#else
+static inline int ffs (int x)
+{
+ /* adapted from Hacker's Delight */
+ int bnz, b0, b1, b2, b3, b4;
+ CAMLassert ((x & 0xFFFFFFFF) == x);
+ x = x & -x;
+ bnz = x != 0;
+ b4 = !!(x & 0xFFFF0000) << 4;
+ b3 = !!(x & 0xFF00FF00) << 3;
+ b2 = !!(x & 0xF0F0F0F0) << 2;
+ b1 = !!(x & 0xCCCCCCCC) << 1;
+ b0 = !!(x & 0xAAAAAAAA);
+ return bnz + b0 + b1 + b2 + b3 + b4;
+}
+#endif /* HAS_FFS or HAS_BITSCANFORWARD */
+
+/* Indexing starts at 1 because that's the minimum block size. */
+static inline void set_map (int index)
+{
+ bf_small_map |= (1 << (index - 1));
+}
+static inline void unset_map (int index)
+{
+ bf_small_map &= ~(1 << (index - 1));
+}
+
+
+/* debug functions for checking the data structures */
+
+#if defined (DEBUG) || FREELIST_DEBUG
+
+static mlsize_t bf_check_cur_size = 0;
+static asize_t bf_check_subtree (large_free_block *p)
+{
+ mlsize_t wosz;
+ large_free_block *cur, *next;
+ asize_t total_size = 0;
+
+ if (p == NULL) return 0;
+
+ wosz = bf_large_wosize(p);
+ CAMLassert (p->isnode == 1);
+ total_size += bf_check_subtree (p->left);
+ CAMLassert (wosz > BF_NUM_SMALL);
+ CAMLassert (wosz > bf_check_cur_size);
+ bf_check_cur_size = wosz;
+ cur = p;
+ while (1){
+ CAMLassert (bf_large_wosize (cur) == wosz);
+ CAMLassert (Color_val ((value) cur) == Caml_blue);
+ CAMLassert ((cur == p && cur->isnode == 1) || cur->isnode == 0);
+ total_size += Whsize_wosize (wosz);
+ next = cur->next;
+ CAMLassert (next->prev == cur);
+ if (next == p) break;
+ cur = next;
+ }
+ total_size += bf_check_subtree (p->right);
+ return total_size;
+}
+
+static void bf_check (void)
+{
+ mlsize_t i;
+ asize_t total_size = 0;
+ int map = 0;
+
+ /* check free lists */
+ CAMLassert (BF_NUM_SMALL <= 8 * sizeof (int));
+ for (i = 1; i <= BF_NUM_SMALL; i++){
+ value b;
+ int col = 0;
+ int merge_found = 0;
+
+ if (bf_small_fl[i].merge == &bf_small_fl[i].free){
+ merge_found = 1;
+ }else{
+ CAMLassert (caml_gc_phase != Phase_sweep
+ || caml_fl_merge == Val_NULL
+ || Val_bp (bf_small_fl[i].merge) < caml_fl_merge);
+ }
+ CAMLassert (*bf_small_fl[i].merge == Val_NULL
+ || Color_val (*bf_small_fl[i].merge) == Caml_blue);
+ if (bf_small_fl[i].free != Val_NULL) map |= 1 << (i-1);
+ for (b = bf_small_fl[i].free; b != Val_NULL; b = Next_small (b)){
+ if (bf_small_fl[i].merge == &Next_small (b)) merge_found = 1;
+ CAMLassert (Wosize_val (b) == i);
+ total_size += Whsize_wosize (i);
+ if (Color_val (b) == Caml_blue){
+ col = 1;
+ CAMLassert (Next_small (b) == Val_NULL
+ || Bp_val (Next_small (b)) > Bp_val (b));
+ }else{
+ CAMLassert (col == 0);
+ CAMLassert (Color_val (b) == Caml_white);
+ }
+ }
+ if (caml_gc_phase == Phase_sweep) CAMLassert (merge_found);
+ }
+ CAMLassert (map == bf_small_map);
+ /* check [caml_fl_merge] */
+ CAMLassert (caml_gc_phase != Phase_sweep
+ || caml_fl_merge == Val_NULL
+ || Hp_val (caml_fl_merge) < (header_t *) caml_gc_sweep_hp);
+ /* check the tree */
+ bf_check_cur_size = 0;
+ total_size += bf_check_subtree (bf_large_tree);
+ /* check the total free set size */
+ CAMLassert (total_size == caml_fl_cur_wsz);
+ /* check the smallest-block pointer */
+ if (bf_large_least != NULL){
+ large_free_block *x = bf_large_tree;
+ while (x->left != NULL) x = x->left;
+ CAMLassert (x == bf_large_least);
+ CAMLassert (x->isnode == 1);
+ CAMLassert (x->prev == x);
+ CAMLassert (x->next == x);
+ }
+}
+
+#endif /* DEBUG || FREELIST_DEBUG */
+
+#if FREELIST_DEBUG
+#define FREELIST_DEBUG_bf_check() bf_check ()
+#else
+#define FREELIST_DEBUG_bf_check()
+#endif
+
+/**************************************************************************/
+/* splay trees */
+
+/* Our tree is composed of nodes. Each node is the head of a doubly-linked
+ circular list of blocks, all of the same size.
+*/
+
+/* Search for the node of the given size. Return a pointer to the pointer
+ to the node, or a pointer to the NULL where the node should have been
+ (it can be inserted here).
+*/
+static large_free_block **bf_search (mlsize_t wosz)
+{
+ large_free_block **p = &bf_large_tree;
+ large_free_block *cur;
+ mlsize_t cursz;
+
+ while (1){
+ cur = *p;
+ INSTR_alloc_jump (1);
+ if (cur == NULL) break;
+ cursz = bf_large_wosize (cur);
+ if (cursz == wosz){
+ break;
+ }else if (cursz > wosz){
+ p = &(cur->left);
+ }else{
+ CAMLassert (cursz < wosz);
+ p = &(cur->right);
+ }
+ }
+ return p;
+}
+
+/* Search for the least node that is large enough to accomodate the given
+ size. Return in [next_lower] an upper bound on either the size of the
+ next-lower node in the tree, or BF_NUM_SMALL if there is no such node.
+*/
+static large_free_block **bf_search_best (mlsize_t wosz, mlsize_t *next_lower)
+{
+ large_free_block **p = &bf_large_tree;
+ large_free_block **best = NULL;
+ mlsize_t lowsz = BF_NUM_SMALL;
+ large_free_block *cur;
+ mlsize_t cursz;
+
+ while (1){
+ cur = *p;
+ INSTR_alloc_jump (1);
+ if (cur == NULL){
+ *next_lower = lowsz;
+ break;
+ }
+ cursz = bf_large_wosize (cur);
+ if (cursz == wosz){
+ best = p;
+ *next_lower = wosz;
+ break;
+ }else if (cursz > wosz){
+ best = p;
+ p = &(cur->left);
+ }else{
+ CAMLassert (cursz < wosz);
+ lowsz = cursz;
+ p = &(cur->right);
+ }
+ }
+ return best;
+}
+
+/* Splay the tree at the given size. If a node of this size exists, it will
+ become the root. If not, the last visited node will be the root. This is
+ either the least node larger or the greatest node smaller than the given
+ size.
+ We use simple top-down splaying as described in S&T 85.
+*/
+static void bf_splay (mlsize_t wosz)
+{
+ large_free_block *x, *y;
+ mlsize_t xsz;
+ large_free_block *left_top = NULL;
+ large_free_block *right_top = NULL;
+ large_free_block **left_bottom = &left_top;
+ large_free_block **right_bottom = &right_top;
+
+ x = bf_large_tree;
+ if (x == NULL) return;
+ while (1){
+ xsz = bf_large_wosize (x);
+ if (xsz == wosz) break;
+ if (xsz > wosz){
+ /* zig */
+ y = x->left;
+ INSTR_alloc_jump (1);
+ if (y == NULL) break;
+ if (bf_large_wosize (y) > wosz){
+ /* zig-zig: rotate right */
+ x->left = y->right;
+ y->right = x;
+ x = y;
+ y = x->left;
+ INSTR_alloc_jump (2);
+ if (y == NULL) break;
+ }
+ /* link right */
+ *right_bottom = x;
+ right_bottom = &(x->left);
+ x = y;
+ }else{
+ CAMLassert (xsz < wosz);
+ /* zag */
+ y = x->right;
+ INSTR_alloc_jump (1);
+ if (y == NULL) break;
+ if (bf_large_wosize (y) < wosz){
+ /* zag-zag : rotate left */
+ x->right = y->left;
+ y->left = x;
+ x = y;
+ y = x->right;
+ INSTR_alloc_jump (2);
+ if (y == NULL) break;
+ }
+ /* link left */
+ *left_bottom = x;
+ left_bottom = &(x->right);
+ x = y;
+ }
+ }
+ /* reassemble the tree */
+ *left_bottom = x->left;
+ *right_bottom = x->right;
+ x->left = left_top;
+ x->right = right_top;
+ INSTR_alloc_jump (2);
+ bf_large_tree = x;
+}
+
+/* Splay the subtree at [p] on its leftmost (least) node. After this
+ operation, the root node of the subtree is the least node and it
+ has no left child.
+ The subtree must not be empty.
+*/
+static void bf_splay_least (large_free_block **p)
+{
+ large_free_block *x, *y;
+ large_free_block *right_top = NULL;
+ large_free_block **right_bottom = &right_top;
+
+ x = *p;
+ INSTR_alloc_jump (1);
+ CAMLassert (x != NULL);
+ while (1){
+ /* We are always in the zig case. */
+ y = x->left;
+ INSTR_alloc_jump (1);
+ if (y == NULL) break;
+ /* And in the zig-zig case. rotate right */
+ x->left = y->right;
+ y->right = x;
+ x = y;
+ y = x->left;
+ INSTR_alloc_jump (2);
+ if (y == NULL) break;
+ /* link right */
+ *right_bottom = x;
+ right_bottom = &(x->left);
+ x = y;
+ }
+ /* reassemble the tree */
+ CAMLassert (x->left == NULL);
+ *right_bottom = x->right;
+ INSTR_alloc_jump (1);
+ x->right = right_top;
+ *p = x;
+}
+
+/* Remove the node at [p], if any. */
+static void bf_remove_node (large_free_block **p)
+{
+ large_free_block *x;
+ large_free_block *l, *r;
+
+ x = *p;
+ INSTR_alloc_jump (1);
+ if (x == NULL) return;
+ if (x == bf_large_least) bf_large_least = NULL;
+ l = x->left;
+ r = x->right;
+ INSTR_alloc_jump (2);
+ if (l == NULL){
+ *p = r;
+ }else if (r == NULL){
+ *p = l;
+ }else{
+ bf_splay_least (&r);
+ r->left = l;
+ *p = r;
+ }
+}
+
+/* Insert a block into the tree, either as a new node or as a block in an
+ existing list.
+ Splay if the list is already present.
+*/
+static void bf_insert_block (large_free_block *n)
+{
+ mlsize_t sz = bf_large_wosize (n);
+ large_free_block **p = bf_search (sz);
+ large_free_block *x = *p;
+ INSTR_alloc_jump (1);
+
+ if (bf_large_least != NULL){
+ mlsize_t least_sz = bf_large_wosize (bf_large_least);
+ if (sz < least_sz){
+ CAMLassert (x == NULL);
+ bf_large_least = n;
+ }else if (sz == least_sz){
+ CAMLassert (x == bf_large_least);
+ bf_large_least = NULL;
+ }
+ }
+
+ CAMLassert (Color_val ((value) n) == Caml_blue);
+ CAMLassert (Wosize_val ((value) n) > BF_NUM_SMALL);
+ if (x == NULL){
+ /* add new node */
+ n->isnode = 1;
+ n->left = n->right = NULL;
+ n->prev = n->next = n;
+ *p = n;
+ }else{
+ /* insert at tail of doubly-linked list */
+ CAMLassert (x->isnode == 1);
+ n->isnode = 0;
+#ifdef DEBUG
+ n->left = n->right = (large_free_block *) Debug_free_unused;
+#endif
+ n->prev = x->prev;
+ n->next = x;
+ x->prev->next = n;
+ x->prev = n;
+ INSTR_alloc_jump (2);
+ bf_splay (sz);
+ }
+}
+
+#if defined (DEBUG) || FREELIST_DEBUG
+static int bf_is_in_tree (large_free_block *b)
+{
+ int wosz = bf_large_wosize (b);
+ large_free_block **p = bf_search (wosz);
+ large_free_block *n = *p;
+ large_free_block *cur = n;
+
+ if (n == NULL) return 0;
+ while (1){
+ if (cur == b) return 1;
+ cur = cur->next;
+ if (cur == n) return 0;
+ }
+}
+#endif /* DEBUG || FREELIST_DEBUG */
+
+/**************************************************************************/
+
+/* Add back a remnant into a small free list. The block must be small
+ and white (or a 0-size fragment).
+ The block may be left out of the list depending on the sweeper's state.
+ The free list size is updated accordingly.
+
+ The block will be left out of the list if the GC is in its Sweep phase
+ and the block is in the still-to-be-swept region because every block of
+ the free list encountered by the sweeper must be blue and linked in
+ its proper place in the increasing-addresses order of the list. This is
+ to ensure that coalescing is always done when two or more free blocks
+ are adjacent.
+*/
+static void bf_insert_remnant_small (value v)
+{
+ mlsize_t wosz = Wosize_val (v);
+
+ CAMLassert (Color_val (v) == Caml_white);
+ CAMLassert (wosz <= BF_NUM_SMALL);
+ if (wosz != 0
+ && (caml_gc_phase != Phase_sweep
+ || (char *) Hp_val (v) < (char *) caml_gc_sweep_hp)){
+ caml_fl_cur_wsz += Whsize_wosize (wosz);
+ Next_small (v) = bf_small_fl[wosz].free;
+ bf_small_fl[wosz].free = v;
+ if (bf_small_fl[wosz].merge == &bf_small_fl[wosz].free){
+ bf_small_fl[wosz].merge = &Next_small (v);
+ }
+ set_map (wosz);
+ }
+}
+
+/* Add back a remnant into the free set. The block must have the
+ appropriate color:
+ - White if it is a fragment or a small block (wosize <= BF_NUM_SMALL)
+ - Blue if it is a large block (BF_NUM_SMALL < wosize)
+ The block may be left out or the set, depending on its size and the
+ sweeper's state.
+ The free list size is updated accordingly.
+*/
+static void bf_insert_remnant (value v)
+{
+ mlsize_t wosz = Wosize_val (v);
+
+ if (wosz <= BF_NUM_SMALL){
+ CAMLassert (Color_val (v) == Caml_white);
+ bf_insert_remnant_small (v);
+ }else{
+ CAMLassert (Color_val (v) == Caml_blue);
+ bf_insert_block ((large_free_block *) v);
+ caml_fl_cur_wsz += Whsize_wosize (wosz);
+ }
+}
+/* Insert the block into the free set during sweep. The block must be blue. */
+static void bf_insert_sweep (value v)
+{
+ mlsize_t wosz = Wosize_val (v);
+ value next;
+
+ CAMLassert (Color_val (v) == Caml_blue);
+ if (wosz <= BF_NUM_SMALL){
+ while (1){
+ next = *bf_small_fl[wosz].merge;
+ if (next == Val_NULL){
+ set_map (wosz);
+ break;
+ }
+ if (Bp_val (next) >= Bp_val (v)) break;
+ bf_small_fl[wosz].merge = &Next_small (next);
+ }
+ Next_small (v) = *bf_small_fl[wosz].merge;
+ *bf_small_fl[wosz].merge = v;
+ bf_small_fl[wosz].merge = &Next_small (v);
+ }else{
+ bf_insert_block ((large_free_block *) v);
+ }
+}
+
+/* Remove a given block from the free set. */
+static void bf_remove (value v)
+{
+ mlsize_t wosz = Wosize_val (v);
+
+ CAMLassert (Color_val (v) == Caml_blue);
+ if (wosz <= BF_NUM_SMALL){
+ while (*bf_small_fl[wosz].merge != v){
+ CAMLassert (Bp_val (*bf_small_fl[wosz].merge) < Bp_val (v));
+ bf_small_fl[wosz].merge = &Next_small (*bf_small_fl[wosz].merge);
+ }
+ *bf_small_fl[wosz].merge = Next_small (v);
+ if (bf_small_fl[wosz].free == Val_NULL) unset_map (wosz);
+ }else{
+ large_free_block *b = (large_free_block *) v;
+ CAMLassert (bf_is_in_tree (b));
+ CAMLassert (b->prev->next == b);
+ CAMLassert (b->next->prev == b);
+ if (b->isnode){
+ large_free_block **p = bf_search (bf_large_wosize (b));
+ CAMLassert (*p != NULL);
+ if (b->next == b){
+ bf_remove_node (p);
+ }else{
+ large_free_block *n = b->next;
+ n->prev = b->prev;
+ b->prev->next = n;
+ *p = n;
+ n->isnode = 1;
+ n->left = b->left;
+ n->right = b->right;
+#ifdef DEBUG
+ Field ((value) b, 0) = Debug_free_major;
+ b->left = b->right = b->next = b->prev =
+ (large_free_block *) Debug_free_major;
+#endif
+ }
+ }else{
+ b->prev->next = b->next;
+ b->next->prev = b->prev;
+ }
+ }
+}
+
+/* Split the given block, return a new block of the given size.
+ The remnant is still at the same address, its size is changed
+ and its color becomes white.
+ The size of the free set is decremented by the whole block size
+ and the caller must readjust it if the remnant is reinserted or
+ remains in the free set.
+ The size of [v] must be strictly greater than [wosz].
+*/
+static header_t *bf_split_small (mlsize_t wosz, value v)
+{
+ intnat blocksz = Whsize_val (v);
+ intnat remwhsz = blocksz - Whsize_wosize (wosz);
+
+ CAMLassert (Wosize_val (v) > wosz);
+ caml_fl_cur_wsz -= blocksz;
+ Hd_val (v) = Make_header (Wosize_whsize (remwhsz), Abstract_tag, Caml_white);
+ return (header_t *) &Field (v, Wosize_whsize (remwhsz));
+}
+
+/* Split the given block, return a new block of the given size.
+ The original block is at the same address but its size is changed.
+ Its color and tag are changed as appropriate for calling the
+ insert_remnant* functions.
+ The size of the free set is decremented by the whole block size
+ and the caller must readjust it if the remnant is reinserted or
+ remains in the free set.
+ The size of [v] must be strictly greater than [wosz].
+*/
+static header_t *bf_split (mlsize_t wosz, value v)
+{
+ header_t hd = Hd_val (v);
+ mlsize_t remwhsz = Whsize_hd (hd) - Whsize_wosize (wosz);
+
+ CAMLassert (Wosize_val (v) > wosz);
+ CAMLassert (remwhsz > 0);
+ caml_fl_cur_wsz -= Whsize_hd (hd);
+ if (remwhsz <= Whsize_wosize (BF_NUM_SMALL)){
+ /* Same as bf_split_small. */
+ Hd_val (v) = Make_header (Wosize_whsize(remwhsz), Abstract_tag, Caml_white);
+ }else{
+ Hd_val (v) = Make_header (Wosize_whsize (remwhsz), 0, Caml_blue);
+ }
+ return (header_t *) &Field (v, Wosize_whsize (remwhsz));
+}
+
+/* Allocate from a large block at [p]. If the node is single and the remaining
+ size is greater than [bound], it stays at the same place in the tree.
+ If [set_least] is true, [wosz] is guaranteed to be [<= BF_NUM_SMALL], so
+ the block has the smallest size in the tree.
+ In this case, the large block becomes (or remains) the single smallest
+ in the tree and we set the [bf_large_least] pointer.
+*/
+static header_t *bf_alloc_from_large (mlsize_t wosz, large_free_block **p,
+ mlsize_t bound, int set_least)
+{
+ large_free_block *n = *p;
+ large_free_block *b;
+ header_t *result;
+ mlsize_t wosize_n = bf_large_wosize (n);
+
+ CAMLassert (bf_large_wosize (n) >= wosz);
+ if (n->next == n){
+ if (wosize_n > bound + Whsize_wosize (wosz)){
+ /* TODO splay at [n]? if the remnant is larger than [wosz]? */
+ if (set_least){
+ CAMLassert (bound == BF_NUM_SMALL);
+ bf_large_least = n;
+ }
+ result = bf_split (wosz, (value) n);
+ caml_fl_cur_wsz += Whsize_wosize (wosize_n) - Whsize_wosize (wosz);
+ /* remnant stays in tree */
+ return result;
+ }else{
+ bf_remove_node (p);
+ if (wosize_n == wosz){
+ caml_fl_cur_wsz -= Whsize_wosize (wosz);
+ return Hp_val ((value) n);
+ }else{
+ result = bf_split (wosz, (value) n);
+ bf_insert_remnant ((value) n);
+ return result;
+ }
+ }
+ }else{
+ b = n->next;
+ CAMLassert (bf_large_wosize (b) == bf_large_wosize (n));
+ n->next = b->next;
+ b->next->prev = n;
+ if (wosize_n == wosz){
+ caml_fl_cur_wsz -= Whsize_wosize (wosz);
+ return Hp_val ((value) b);
+ }else{
+ result = bf_split (wosz, (value) b);
+ bf_insert_remnant ((value) b);
+ /* TODO: splay at [n] if the remnant is smaller than [wosz] */
+ if (set_least){
+ CAMLassert (bound == BF_NUM_SMALL);
+ if (bf_large_wosize (b) > BF_NUM_SMALL){
+ bf_large_least = b;
+ }
+ }
+ return result;
+ }
+ }
+}
+
+static header_t *bf_allocate_from_tree (mlsize_t wosz, int set_least)
+{
+ large_free_block **n;
+ mlsize_t bound;
+
+ n = bf_search_best (wosz, &bound);
+ if (n == NULL) return NULL;
+ return bf_alloc_from_large (wosz, n, bound, set_least);
+}
+
+static header_t *bf_allocate (mlsize_t wosz)
+{
+ value block;
+ header_t *result;
+
+ CAMLassert (sizeof (char *) == sizeof (value));
+ CAMLassert (wosz >= 1);
+
+#ifdef CAML_INSTR
+ if (wosz < 10){
+ ++instr_size[wosz];
+ }else if (wosz < 100){
+ ++instr_size[wosz/10 + 9];
+ }else{
+ ++instr_size[19];
+ }
+#endif /* CAML_INSTR */
+
+ if (wosz <= BF_NUM_SMALL){
+ if (bf_small_fl[wosz].free != Val_NULL){
+ /* fast path: allocate from the corresponding free list */
+ block = bf_small_fl[wosz].free;
+ if (bf_small_fl[wosz].merge == &Next_small (block)){
+ bf_small_fl[wosz].merge = &bf_small_fl[wosz].free;
+ }
+ bf_small_fl[wosz].free = Next_small (block);
+ if (bf_small_fl[wosz].free == Val_NULL) unset_map (wosz);
+ caml_fl_cur_wsz -= Whsize_wosize (wosz);
+ FREELIST_DEBUG_bf_check ();
+ return Hp_val (block);
+ }else{
+ /* allocate from the next available size */
+ mlsize_t s = ffs (bf_small_map & ((-1) << wosz));
+ FREELIST_DEBUG_bf_check ();
+ if (s != 0){
+ block = bf_small_fl[s].free;
+ CAMLassert (block != Val_NULL);
+ if (bf_small_fl[s].merge == &Next_small (block)){
+ bf_small_fl[s].merge = &bf_small_fl[s].free;
+ }
+ bf_small_fl[s].free = Next_small (block);
+ if (bf_small_fl[s].free == Val_NULL) unset_map (s);
+ result = bf_split_small (wosz, block);
+ bf_insert_remnant_small (block);
+ FREELIST_DEBUG_bf_check ();
+ return result;
+ }
+ }
+ /* Failed to find a suitable small block: try [bf_large_least]. */
+ if (bf_large_least != NULL){
+ mlsize_t least_wosz = bf_large_wosize (bf_large_least);
+ if (least_wosz > BF_NUM_SMALL + Whsize_wosize (wosz)){
+ result = bf_split (wosz, (value) bf_large_least);
+ caml_fl_cur_wsz += Whsize_wosize (least_wosz) - Whsize_wosize (wosz);
+ /* remnant stays in tree */
+ CAMLassert (Color_val ((value) bf_large_least) == Caml_blue);
+ return result;
+ }
+ }
+
+ /* Allocate from the tree and update [bf_large_least]. */
+ result = bf_allocate_from_tree (wosz, 1);
+ FREELIST_DEBUG_bf_check ();
+ return result;
+ }else{
+ result = bf_allocate_from_tree (wosz, 0);
+ FREELIST_DEBUG_bf_check ();
+ return result;
+ }
+}
+
+static void bf_init_merge (void)
+{
+ mlsize_t i;
+
+#ifdef CAML_INSTR
+ for (i = 1; i < 20; i++){
+ CAML_INSTR_INT (instr_name[i], instr_size[i]);
+ instr_size[i] = 0;
+ }
+#endif /* CAML_INSTR */
+
+ caml_fl_merge = Val_NULL;
+
+ for (i = 1; i <= BF_NUM_SMALL; i++){
+ /* At the beginning of each small free list is a segment of remnants
+ that were pushed back to the list after splitting. These are white
+ and they are not in order. We need to remove them
+ from the list for coalescing to work. They
+ will be picked up by the sweeping code and inserted in the right
+ place in the list.
+ */
+ value p = bf_small_fl[i].free;
+ while (1){
+ if (p == Val_NULL){
+ unset_map (i);
+ break;
+ }
+ if (Color_val (p) == Caml_blue) break;
+ CAMLassert (Color_val (p) == Caml_white);
+ caml_fl_cur_wsz -= Whsize_val (p);
+ p = Next_small (p);
+ }
+ bf_small_fl[i].free = p;
+ /* Set the merge pointer to its initial value */
+ bf_small_fl[i].merge = &bf_small_fl[i].free;
+ }
+}
+
+static void bf_reset (void)
+{
+ mlsize_t i;
+
+ for (i = 1; i <= BF_NUM_SMALL; i++){
+ bf_small_fl[i].free = Val_NULL;
+ bf_small_fl[i].merge = &bf_small_fl[i].free;
+ }
+ bf_small_map = 0;
+ bf_large_tree = NULL;
+ bf_large_least = NULL;
+ caml_fl_cur_wsz = 0;
+ bf_init_merge ();
+}
+
+static header_t *bf_merge_block (value bp, char *limit)
+{
+ value start;
+ value cur;
+ mlsize_t wosz;
+
+ CAMLassert (Color_val (bp) == Caml_white);
+ /* Find the starting point of the current run of free blocks. */
+ if (caml_fl_merge != Val_NULL && Next_in_mem (caml_fl_merge) == bp
+ && Color_val (caml_fl_merge) == Caml_blue){
+ start = caml_fl_merge;
+ bf_remove (start);
+ }else{
+ start = bp;
+ }
+ cur = bp;
+ while (1){
+ /* This slightly convoluted loop is just going over the run of
+ white or blue blocks, doing the right thing for each color, and
+ stopping on a gray or black block or when limit is passed.
+ It is convoluted because we start knowing that the first block
+ is white. */
+ white:
+ if (Tag_val (cur) == Custom_tag){
+ void (*final_fun)(value) = Custom_ops_val(cur)->finalize;
+ if (final_fun != NULL) final_fun(cur);
+ }
+ caml_fl_cur_wsz += Whsize_val (cur);
+ next:
+ cur = Next_in_mem (cur);
+ if (Hp_val (cur) >= (header_t *) limit){
+ CAMLassert (Hp_val (cur) == (header_t *) limit);
+ goto end_of_run;
+ }
+ switch (Color_val (cur)){
+ case Caml_white: goto white;
+ case Caml_blue: bf_remove (cur); goto next;
+ case Caml_gray:
+ case Caml_black:
+ goto end_of_run;
+ }
+ }
+ end_of_run:
+ wosz = Wosize_whsize ((value *) cur - (value *) start);
+#ifdef DEBUG
+ {
+ value *p;
+ for (p = (value *) start; p < (value *) Hp_val (cur); p++){
+ *p = Debug_free_major;
+ }
+ }
+#endif
+ while (wosz > Max_wosize){
+ Hd_val (start) = Make_header (Max_wosize, 0, Caml_blue);
+ bf_insert_sweep (start);
+ start = Next_in_mem (start);
+ wosz -= Whsize_wosize (Max_wosize);
+ }
+ if (wosz > 0){
+ Hd_val (start) = Make_header (wosz, 0, Caml_blue);
+ bf_insert_sweep (start);
+ }else{
+ Hd_val (start) = Make_header (0, 0, Caml_white);
+ caml_fl_cur_wsz -= Whsize_wosize (0);
+ }
+ FREELIST_DEBUG_bf_check ();
+ return Hp_val (cur);
+}
+
+static void bf_add_blocks (value bp)
+{
+ while (bp != Val_NULL){
+ value next = Next_small (bp);
+ mlsize_t wosz = Wosize_val (bp);
+
+ if (wosz > BF_NUM_SMALL){
+ caml_fl_cur_wsz += Whsize_wosize (wosz);
+ bf_insert_block ((large_free_block *) bp);
+ }else{
+ Hd_val (bp) = Make_header (wosz, Abstract_tag, Caml_white);
+ bf_insert_remnant_small (bp);
+ }
+ bp = next;
+ }
+}
+
+static void bf_make_free_blocks (value *p, mlsize_t size, int do_merge,
+ int color)
+{
+ mlsize_t sz, wosz;
+
+ while (size > 0){
+ if (size > Whsize_wosize (Max_wosize)){
+ sz = Whsize_wosize (Max_wosize);
+ }else{
+ sz = size;
+ }
+ wosz = Wosize_whsize (sz);
+ if (do_merge){
+ if (wosz <= BF_NUM_SMALL){
+ color = Caml_white;
+ }else{
+ color = Caml_blue;
+ }
+ *(header_t *)p = Make_header (wosz, 0, color);
+ bf_insert_remnant (Val_hp (p));
+ }else{
+ *(header_t *)p = Make_header (wosz, 0, color);
+ }
+ size -= sz;
+ p += sz;
+ }
+}
+
+/*********************** policy selection *****************************/
+
+enum {
+ policy_next_fit = 0,
+ policy_first_fit = 1,
+ policy_best_fit = 2,
+};
+
+uintnat caml_allocation_policy = policy_next_fit;
+
+/********************* exported functions *****************************/
+
+/* [caml_fl_allocate] does not set the header of the newly allocated block.
+ The calling function must do it before any GC function gets called.
+ [caml_fl_allocate] returns a head pointer, or NULL if no suitable block
+ is found in the free set.
+*/
+header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = &nf_allocate;
+
+/* Initialize the merge_block machinery (at start of sweeping). */
+void (*caml_fl_p_init_merge) (void) = &nf_init_merge;
+
+/* This is called by caml_compact_heap. */
+void (*caml_fl_p_reset) (void) = &nf_reset;
+
+/* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
+ because merging blocks may change the size of [bp]. */
+header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = &nf_merge_block;
+
+/* [bp] must point to a list of blocks of wosize >= 1 chained by their field 0,
+ terminated by Val_NULL, and field 1 of the first block must point to
+ the last block.
+ The blocks must be blue.
+*/
+void (*caml_fl_p_add_blocks) (value bp) = &nf_add_blocks;
+
+/* Cut a block of memory into pieces of size [Max_wosize], give them headers,
+ and optionally merge them into the free list.
+ arguments:
+ p: pointer to the first word of the block
+ size: size of the block (in words)
+ do_merge: 1 -> do merge; 0 -> do not merge
+ color: which color to give to the pieces; if [do_merge] is 1, this
+ is overridden by the merge code, but we have historically used
+ [Caml_white].
+*/
+void (*caml_fl_p_make_free_blocks)
+ (value *p, mlsize_t size, int do_merge, int color)
+ = &nf_make_free_blocks;
+#ifdef DEBUG
+void (*caml_fl_p_check) (void) = &nf_check;
+#endif
+
+void caml_set_allocation_policy (intnat p)
+{
switch (p){
- case Policy_next_fit:
- fl_prev = Fl_head;
- policy = p;
+ case policy_next_fit: default:
+ caml_allocation_policy = policy_next_fit;
+ caml_fl_p_allocate = &nf_allocate;
+ caml_fl_p_init_merge = &nf_init_merge;
+ caml_fl_p_reset = &nf_reset;
+ caml_fl_p_merge_block = &nf_merge_block;
+ caml_fl_p_add_blocks = &nf_add_blocks;
+ caml_fl_p_make_free_blocks = &nf_make_free_blocks;
+#ifdef DEBUG
+ caml_fl_p_check = &nf_check;
+#endif
break;
- case Policy_first_fit:
- flp_size = 0;
- beyond = Val_NULL;
- policy = p;
+ case policy_first_fit:
+ caml_allocation_policy = policy_first_fit;
+ caml_fl_p_allocate = &ff_allocate;
+ caml_fl_p_init_merge = &ff_init_merge;
+ caml_fl_p_reset = &ff_reset;
+ caml_fl_p_merge_block = &ff_merge_block;
+ caml_fl_p_add_blocks = &ff_add_blocks;
+ caml_fl_p_make_free_blocks = &ff_make_free_blocks;
+#ifdef DEBUG
+ caml_fl_p_check = &ff_check;
+#endif
break;
- default:
+ case policy_best_fit:
+ caml_allocation_policy = policy_best_fit;
+ caml_fl_p_allocate = &bf_allocate;
+ caml_fl_p_init_merge = &bf_init_merge;
+ caml_fl_p_reset = &bf_reset;
+ caml_fl_p_merge_block = &bf_merge_block;
+ caml_fl_p_add_blocks = &bf_add_blocks;
+ caml_fl_p_make_free_blocks = &bf_make_free_blocks;
+#ifdef DEBUG
+ caml_fl_p_check = &bf_check;
+#endif
break;
}
}
extern uintnat caml_max_stack_size; /* defined in stacks.c */
#endif
-double caml_stat_minor_words = 0.0,
- caml_stat_promoted_words = 0.0,
- caml_stat_major_words = 0.0;
-
-intnat caml_stat_minor_collections = 0,
- caml_stat_major_collections = 0,
- caml_stat_heap_wsz = 0,
- caml_stat_top_heap_wsz = 0,
- caml_stat_compactions = 0,
- caml_stat_heap_chunks = 0;
-
extern uintnat caml_major_heap_increment; /* percent or words; see major_gc.c */
extern uintnat caml_percent_free; /* see major_gc.c */
extern uintnat caml_percent_max; /* see compact.c */
#ifdef DEBUG
caml_final_invariant_check();
+ caml_fl_check ();
#endif
- CAMLassert (heap_chunks == caml_stat_heap_chunks);
- CAMLassert (live_words + free_words + fragments == caml_stat_heap_wsz);
+ CAMLassert (heap_chunks == Caml_state->stat_heap_chunks);
+ CAMLassert (live_words + free_words + fragments == Caml_state->stat_heap_wsz);
if (returnstats){
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
- double minwords = caml_stat_minor_words
- + (double) (caml_young_alloc_end - caml_young_ptr);
- double prowords = caml_stat_promoted_words;
- double majwords = caml_stat_major_words + (double) caml_allocated_words;
- intnat mincoll = caml_stat_minor_collections;
- intnat majcoll = caml_stat_major_collections;
- intnat heap_words = caml_stat_heap_wsz;
- intnat cpct = caml_stat_compactions;
- intnat top_heap_words = caml_stat_top_heap_wsz;
+ double minwords =
+ Caml_state->stat_minor_words
+ + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr);
+ double prowords = Caml_state->stat_promoted_words;
+ double majwords =
+ Caml_state->stat_major_words + (double) caml_allocated_words;
+ intnat mincoll = Caml_state->stat_minor_collections;
+ intnat majcoll = Caml_state->stat_major_collections;
+ intnat heap_words = Caml_state->stat_heap_wsz;
+ intnat cpct = Caml_state->stat_compactions;
+ intnat top_heap_words = Caml_state->stat_top_heap_wsz;
res = caml_alloc_tuple (16);
Store_field (res, 0, caml_copy_double (minwords));
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
- double minwords = caml_stat_minor_words
- + (double) (caml_young_alloc_end - caml_young_ptr);
- double prowords = caml_stat_promoted_words;
- double majwords = caml_stat_major_words + (double) caml_allocated_words;
- intnat mincoll = caml_stat_minor_collections;
- intnat majcoll = caml_stat_major_collections;
- intnat heap_words = caml_stat_heap_wsz;
- intnat top_heap_words = caml_stat_top_heap_wsz;
- intnat cpct = caml_stat_compactions;
- intnat heap_chunks = caml_stat_heap_chunks;
+ double minwords =
+ Caml_state->stat_minor_words
+ + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr);
+ double prowords = Caml_state->stat_promoted_words;
+ double majwords =
+ Caml_state->stat_major_words + (double) caml_allocated_words;
+ intnat mincoll = Caml_state->stat_minor_collections;
+ intnat majcoll = Caml_state->stat_major_collections;
+ intnat heap_words = Caml_state->stat_heap_wsz;
+ intnat top_heap_words = Caml_state->stat_top_heap_wsz;
+ intnat cpct = Caml_state->stat_compactions;
+ intnat heap_chunks = Caml_state->stat_heap_chunks;
res = caml_alloc_tuple (16);
Store_field (res, 0, caml_copy_double (minwords));
double caml_gc_minor_words_unboxed()
{
- return (caml_stat_minor_words
- + (double) (caml_young_alloc_end - caml_young_ptr));
+ return (Caml_state->stat_minor_words
+ + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr));
}
CAMLprim value caml_gc_minor_words(value v)
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
- double minwords = caml_stat_minor_words
- + (double) (caml_young_alloc_end - caml_young_ptr);
- double prowords = caml_stat_promoted_words;
- double majwords = caml_stat_major_words + (double) caml_allocated_words;
+ double minwords =
+ Caml_state->stat_minor_words
+ + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr);
+ double prowords = Caml_state->stat_promoted_words;
+ double majwords =
+ Caml_state->stat_major_words + (double) caml_allocated_words;
res = caml_alloc_tuple (3);
Store_field (res, 0, caml_copy_double (minwords));
CAMLlocal1 (res);
res = caml_alloc_tuple (11);
- Store_field (res, 0, Val_long (caml_minor_heap_wsz)); /* s */
+ Store_field (res, 0, Val_long (Caml_state->minor_heap_wsz)); /* s */
Store_field (res, 1, Val_long (caml_major_heap_increment)); /* i */
Store_field (res, 2, Val_long (caml_percent_free)); /* o */
Store_field (res, 3, Val_long (caml_verb_gc)); /* v */
uintnat newpf, newpm;
asize_t newheapincr;
asize_t newminwsz;
- uintnat oldpolicy;
+ uintnat newpolicy;
uintnat new_custom_maj, new_custom_min, new_custom_sz;
CAML_INSTR_SETUP (tmr, "");
caml_major_heap_increment);
}
}
- oldpolicy = caml_allocation_policy;
- caml_set_allocation_policy (Long_val (Field (v, 6)));
- if (oldpolicy != caml_allocation_policy){
- caml_gc_message (0x20, "New allocation policy: %"
- ARCH_INTNAT_PRINTF_FORMAT "u\n", caml_allocation_policy);
- }
/* This field was added in 4.03.0. */
if (Wosize_val (v) >= 8){
}
}
- /* Minor heap size comes last because it will trigger a minor collection
- (thus invalidating [v]) and it can raise [Out_of_memory]. */
+ /* Save field 0 before [v] is invalidated. */
newminwsz = norm_minsize (Long_val (Field (v, 0)));
- if (newminwsz != caml_minor_heap_wsz){
+
+ /* Switching allocation policies must trigger a compaction, so it
+ invalidates [v]. */
+ newpolicy = Long_val (Field (v, 6));
+ if (newpolicy != caml_allocation_policy){
+ caml_empty_minor_heap ();
+ caml_finish_major_cycle ();
+ caml_finish_major_cycle ();
+ caml_compact_heap (newpolicy);
+ caml_gc_message (0x20, "New allocation policy: %"
+ ARCH_INTNAT_PRINTF_FORMAT "u\n", newpolicy);
+ }
+
+ /* Minor heap size comes last because it can raise [Out_of_memory]. */
+ if (newminwsz != Caml_state->minor_heap_wsz){
caml_gc_message (0x20, "New minor heap size: %"
ARCH_SIZET_PRINTF_FORMAT "uk words\n", newminwsz / 1024);
caml_set_minor_heap_size (Bsize_wsize (newminwsz));
}
CAML_INSTR_TIME (tmr, "explicit/gc_set");
+
+ /* The compaction may have triggered some finalizers that we need to call. */
+ caml_process_pending_actions();
+
return Val_unit;
}
CAML_INSTR_SETUP (tmr, "");
CAMLassert (v == Val_unit);
caml_request_minor_gc ();
- caml_gc_dispatch ();
+ // call the gc and call finalisers
+ caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_minor");
return Val_unit;
}
{
double fp;
- fp = 100.0 * caml_fl_cur_wsz / (caml_stat_heap_wsz - caml_fl_cur_wsz);
+ fp = 100.0 * caml_fl_cur_wsz / (Caml_state->stat_heap_wsz - caml_fl_cur_wsz);
if (fp > 999999.0) fp = 999999.0;
caml_gc_message (0x200, "Estimated overhead (lower bound) = %"
ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
(uintnat) fp);
if (fp >= caml_percent_max){
caml_gc_message (0x200, "Automatic compaction triggered.\n");
- caml_compact_heap ();
+ caml_compact_heap (-1);
}
}
caml_empty_minor_heap ();
caml_finish_major_cycle ();
test_and_compact ();
- caml_final_do_calls ();
+ // call finalisers
+ caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_major");
return Val_unit;
}
caml_gc_message (0x1, "Full major GC cycle requested\n");
caml_empty_minor_heap ();
caml_finish_major_cycle ();
- caml_final_do_calls ();
+ // call finalisers
+ caml_process_pending_actions();
caml_empty_minor_heap ();
caml_finish_major_cycle ();
test_and_compact ();
- caml_final_do_calls ();
+ // call finalisers
+ caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_full_major");
return Val_unit;
}
caml_gc_message (0x10, "Heap compaction requested\n");
caml_empty_minor_heap ();
caml_finish_major_cycle ();
- caml_final_do_calls ();
+ // call finalisers
+ caml_process_pending_actions();
caml_empty_minor_heap ();
caml_finish_major_cycle ();
- caml_compact_heap ();
- caml_final_do_calls ();
+ caml_compact_heap (-1);
+ // call finalisers
+ caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_compact");
return Val_unit;
}
CAMLprim value caml_get_minor_free (value v)
{
- return Val_int (caml_young_ptr - caml_young_alloc_start);
+ return Val_int (Caml_state->young_ptr - Caml_state->young_alloc_start);
}
CAMLprim value caml_get_major_bucket (value v)
major_bsize = ((major_bsize + Page_size - 1) >> Page_log) << Page_log;
caml_instr_init ();
- if (caml_init_alloc_for_heap () != 0){
- caml_fatal_error ("cannot initialize heap: mmap failed");
- }
if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_bsize)){
caml_fatal_error ("cannot initialize page table");
}
caml_custom_minor_max_bsz = custom_bsz;
caml_gc_message (0x20, "Initial minor heap size: %"
ARCH_SIZET_PRINTF_FORMAT "uk words\n",
- caml_minor_heap_wsz / 1024);
+ Caml_state->minor_heap_wsz / 1024);
caml_gc_message (0x20, "Initial major heap size: %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
major_bsize / 1024);
("a=%d,b=%d,H=%"F_Z"u,i=%"F_Z"u,l=%"F_Z"u,o=%"F_Z"u,O=%"F_Z"u,p=%d,"
"s=%"F_S"u,t=%"F_Z"u,v=%"F_Z"u,w=%d,W=%"F_Z"u",
/* a */ (int) caml_allocation_policy,
- /* b */ caml_backtrace_active,
+ /* b */ (int) Caml_state->backtrace_active,
/* h */ /* missing */ /* FIXME add when changed to min_heap_size */
/* H */ caml_use_huge_pages,
/* i */ caml_major_heap_increment,
/* O */ caml_percent_max,
/* p */ caml_parser_trace,
/* R */ /* missing */
- /* s */ caml_minor_heap_wsz,
+ /* s */ Caml_state->minor_heap_wsz,
/* t */ caml_trace_level,
/* v */ caml_verb_gc,
/* w */ caml_major_window,
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* KC Sivaramakrishnan, Indian Institute of Technology, Madras *
+#* *
+#* Copyright 2019 Indian Institute of Technology, Madras *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+BEGIN{FS="[,)] *";count=0};
+/DOMAIN_STATE/{
+ print "Store_" $2 " MACRO reg1, reg2";
+ print " mov [reg1+" count "], reg2";
+ print "ENDM";
+ print "Load_" $2 " MACRO reg1, reg2";
+ print " mov reg2, [reg1+" count "]";
+ print "ENDM";
+ print "Push_" $2 " MACRO reg1";
+ print " push [reg1+" count "]";
+ print "ENDM";
+ print "Pop_" $2 " MACRO reg1";
+ print " pop [reg1+" count "]";
+ print "ENDM";
+ print "Cmp_" $2 " MACRO reg1, reg2";
+ print " cmp reg2, [reg1+" count "]";
+ print "ENDM";
+ print "Sub_" $2 " MACRO reg1, reg2";
+ print " sub reg2, [reg1+" count "]";
+ print "ENDM";
+ count+=8
+}
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* KC Sivaramakrishnan, Indian Institute of Technology, Madras *
+#* *
+#* Copyright 2019 Indian Institute of Technology, Madras *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+BEGIN{FS="[,)] *";count=0};
+/DOMAIN_STATE/{
+ print "Store_" $2 " MACRO reg";
+ print " mov [r14+" count "], reg";
+ print "ENDM";
+ print "Load_" $2 " MACRO reg";
+ print " mov reg, [r14+" count "]";
+ print "ENDM";
+ print "Push_" $2 " MACRO";
+ print " push [r14+" count "]";
+ print "ENDM";
+ print "Pop_" $2 " MACRO";
+ print " pop [r14+" count "]";
+ print "ENDM";
+ print "Cmp_" $2 " MACRO reg";
+ print " cmp reg, [r14+" count "]";
+ print "ENDM";
+ count+=8
+}
(
for prim in \
alloc array compare extern floats gc_ctrl hash intern interp ints io \
- lexing md5 meta obj parsing signals str sys callback weak finalise \
- stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray
+ lexing md5 meta memprof obj parsing signals str sys callback weak \
+ finalise stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray
do
- sed -n -e "s/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p" "$prim.c"
+ sed -n -e 's/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p' "$prim.c"
done
sed -n -e 's/^CAMLprim_int64_[0-9](\([a-z0-9_][a-z0-9_]*\)).*/caml_int64_\1\
caml_int64_\1_native/p' ints.c
#define FUNCTION_ALIGN 2
#endif
+#if defined(FUNCTION_SECTIONS)
+#if defined(SYS_macosx) || defined(SYS_mingw) || defined(SYS_cygwin)
+#define TEXT_SECTION(name)
+#else
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#endif
+#else
+#define TEXT_SECTION(name)
+#endif
+
#define FUNCTION(name) \
+ TEXT_SECTION(caml.##name); \
.globl G(name); \
.align FUNCTION_ALIGN; \
G(name):
#define STACK_PROBE_SIZE 16384
#endif
+ .set domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+ .equ domain_field_caml_##name, domain_curr_field ; \
+ .set domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define CAML_STATE(var,reg) 8*domain_field_caml_##var(reg)
+
/* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays,
even if only MacOS X's ABI formally requires it. */
#define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount)
#define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount)
-/* Allocation */
+#if defined(FUNCTION_SECTIONS)
+ TEXT_SECTION(caml_hot__code_begin)
+ .globl G(caml_hot__code_begin)
+G(caml_hot__code_begin):
+
+ TEXT_SECTION(caml_hot__code_end)
+ .globl G(caml_hot__code_end)
+G(caml_hot__code_end):
+#endif
+/* Allocation */
.text
.globl G(caml_system__code_begin)
G(caml_system__code_begin):
FUNCTION(caml_call_gc)
CFI_STARTPROC
/* Record lowest stack address and return address */
- movl 0(%esp), %eax
- movl %eax, G(caml_last_return_address)
- leal 4(%esp), %eax
- movl %eax, G(caml_bottom_of_stack)
+ pushl %ebx; CFI_ADJUST(4)
+ movl G(Caml_state), %ebx
+ movl 4(%esp), %eax
+ movl %eax, CAML_STATE(last_return_address, %ebx)
+ leal 8(%esp), %eax
+ movl %eax, CAML_STATE(bottom_of_stack, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
LBL(105):
#if !defined(SYS_mingw) && !defined(SYS_cygwin)
/* Touch the stack to trigger a recoverable segfault
movl %eax, 0(%esp)
addl $(STACK_PROBE_SIZE), %esp; CFI_ADJUST(-STACK_PROBE_SIZE);
#endif
- /* Build array of registers, save it into caml_gc_regs */
+ /* Build array of registers, save it into Caml_state->gc_regs */
pushl %ebp; CFI_ADJUST(4)
pushl %edi; CFI_ADJUST(4)
pushl %esi; CFI_ADJUST(4)
pushl %ecx; CFI_ADJUST(4)
pushl %ebx; CFI_ADJUST(4)
pushl %eax; CFI_ADJUST(4)
- movl %esp, G(caml_gc_regs)
+ movl G(Caml_state), %ebx
+ movl %esp, CAML_STATE(gc_regs, %ebx)
/* MacOSX note: 16-alignment of stack preserved at this point */
/* Call the garbage collector */
call G(caml_garbage_collection)
FUNCTION(caml_alloc1)
CFI_STARTPROC
- movl G(caml_young_ptr), %eax
+ pushl %ebx; CFI_ADJUST(4)
+ movl G(Caml_state), %ebx
+ movl CAML_STATE(young_ptr, %ebx), %eax
subl $8, %eax
- movl %eax, G(caml_young_ptr)
- cmpl G(caml_young_limit), %eax
+ cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(100)
+ movl %eax, CAML_STATE(young_ptr, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ret
LBL(100):
- movl 0(%esp), %eax
- movl %eax, G(caml_last_return_address)
- leal 4(%esp), %eax
- movl %eax, G(caml_bottom_of_stack)
+ movl 4(%esp), %eax
+ movl %eax, CAML_STATE(last_return_address, %ebx)
+ leal 8(%esp), %eax
+ movl %eax, CAML_STATE(bottom_of_stack, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(12)
call LBL(105)
UNDO_ALIGN_STACK(12)
FUNCTION(caml_alloc2)
CFI_STARTPROC
- movl G(caml_young_ptr), %eax
+ pushl %ebx; CFI_ADJUST(4)
+ movl G(Caml_state), %ebx
+ movl CAML_STATE(young_ptr, %ebx), %eax
subl $12, %eax
- movl %eax, G(caml_young_ptr)
- cmpl G(caml_young_limit), %eax
+ cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(101)
+ movl %eax, CAML_STATE(young_ptr, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ret
LBL(101):
- movl 0(%esp), %eax
- movl %eax, G(caml_last_return_address)
- leal 4(%esp), %eax
- movl %eax, G(caml_bottom_of_stack)
+ movl 4(%esp), %eax
+ movl %eax, CAML_STATE(last_return_address, %ebx)
+ leal 8(%esp), %eax
+ movl %eax, CAML_STATE(bottom_of_stack, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(12)
call LBL(105)
UNDO_ALIGN_STACK(12)
FUNCTION(caml_alloc3)
CFI_STARTPROC
- movl G(caml_young_ptr), %eax
+ pushl %ebx; CFI_ADJUST(4)
+ movl G(Caml_state), %ebx
+ movl CAML_STATE(young_ptr, %ebx), %eax
subl $16, %eax
- movl %eax, G(caml_young_ptr)
- cmpl G(caml_young_limit), %eax
+ cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(102)
+ movl %eax, CAML_STATE(young_ptr, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ret
LBL(102):
- movl 0(%esp), %eax
- movl %eax, G(caml_last_return_address)
- leal 4(%esp), %eax
- movl %eax, G(caml_bottom_of_stack)
+ movl 4(%esp), %eax
+ movl %eax, CAML_STATE(last_return_address, %ebx)
+ leal 8(%esp), %eax
+ movl %eax, CAML_STATE(bottom_of_stack, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(12)
call LBL(105)
UNDO_ALIGN_STACK(12)
FUNCTION(caml_allocN)
CFI_STARTPROC
- subl G(caml_young_ptr), %eax /* eax = size - caml_young_ptr */
- negl %eax /* eax = caml_young_ptr - size */
- cmpl G(caml_young_limit), %eax
+ pushl %eax; CFI_ADJUST(4) /* saved desired size */
+ pushl %ebx; CFI_ADJUST(4)
+ movl G(Caml_state), %ebx
+ /* eax = size - Caml_state->young_ptr */
+ subl CAML_STATE(young_ptr, %ebx), %eax
+ negl %eax /* eax = Caml_state->young_ptr - size */
+ cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(103)
- movl %eax, G(caml_young_ptr)
+ movl %eax, CAML_STATE(young_ptr, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
+ addl $4, %esp; CFI_ADJUST(-4) /* drop desired size */
ret
LBL(103):
- subl G(caml_young_ptr), %eax /* eax = - size */
- negl %eax /* eax = size */
- pushl %eax; CFI_ADJUST(4) /* save desired size */
- subl %eax, G(caml_young_ptr) /* must update young_ptr */
- movl 4(%esp), %eax
- movl %eax, G(caml_last_return_address)
- leal 8(%esp), %eax
- movl %eax, G(caml_bottom_of_stack)
+ movl 8(%esp), %eax
+ movl %eax, CAML_STATE(last_return_address, %ebx)
+ leal 12(%esp), %eax
+ movl %eax, CAML_STATE(bottom_of_stack, %ebx)
+ popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(8)
call LBL(105)
UNDO_ALIGN_STACK(8)
FUNCTION(caml_c_call)
CFI_STARTPROC
/* Record lowest stack address and return address */
+ /* ecx and edx are destroyed at C call. Use them as temp. */
+ movl G(Caml_state), %ecx
movl (%esp), %edx
- movl %edx, G(caml_last_return_address)
+ movl %edx, CAML_STATE(last_return_address, %ecx)
leal 4(%esp), %edx
- movl %edx, G(caml_bottom_of_stack)
+ movl %edx, CAML_STATE(bottom_of_stack, %ecx)
#if !defined(SYS_mingw) && !defined(SYS_cygwin)
/* Touch the stack to trigger a recoverable segfault
if insufficient space remains */
movl $ G(caml_program), %esi
/* Common code for caml_start_program and caml_callback* */
LBL(106):
+ movl G(Caml_state), %edi
/* Build a callback link */
- pushl G(caml_gc_regs); CFI_ADJUST(4)
- pushl G(caml_last_return_address); CFI_ADJUST(4)
- pushl G(caml_bottom_of_stack); CFI_ADJUST(4)
+ pushl CAML_STATE(gc_regs, %edi); CFI_ADJUST(4)
+ pushl CAML_STATE(last_return_address, %edi); CFI_ADJUST(4)
+ pushl CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(4)
/* Note: 16-alignment preserved on MacOSX at this point */
/* Build an exception handler */
pushl $ LBL(108); CFI_ADJUST(4)
ALIGN_STACK(8)
- pushl G(caml_exception_pointer); CFI_ADJUST(4)
- movl %esp, G(caml_exception_pointer)
+ pushl CAML_STATE(exception_pointer, %edi); CFI_ADJUST(4)
+ movl %esp, CAML_STATE(exception_pointer, %edi)
/* Call the OCaml code */
call *%esi
LBL(107):
+ movl G(Caml_state), %edi
/* Pop the exception handler */
- popl G(caml_exception_pointer); CFI_ADJUST(-4)
+ popl CAML_STATE(exception_pointer, %edi); CFI_ADJUST(-4)
addl $12, %esp ; CFI_ADJUST(-12)
LBL(109):
+ movl G(Caml_state), %edi /* Reload for LBL(109) entry */
/* Pop the callback link, restoring the global variables */
- popl G(caml_bottom_of_stack); CFI_ADJUST(-4)
- popl G(caml_last_return_address); CFI_ADJUST(-4)
- popl G(caml_gc_regs); CFI_ADJUST(-4)
+ popl CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(-4)
+ popl CAML_STATE(last_return_address, %edi); CFI_ADJUST(-4)
+ popl CAML_STATE(gc_regs, %edi); CFI_ADJUST(-4)
/* Restore callee-save registers. */
popl %ebp; CFI_ADJUST(-4)
popl %edi; CFI_ADJUST(-4)
FUNCTION(caml_raise_exn)
CFI_STARTPROC
- testl $1, G(caml_backtrace_active)
+ movl G(Caml_state), %ebx
+ testl $1, CAML_STATE(backtrace_active, %ebx)
jne LBL(110)
- movl G(caml_exception_pointer), %esp
- popl G(caml_exception_pointer); CFI_ADJUST(-4)
+ movl CAML_STATE(exception_pointer, %ebx), %esp
+ popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
LBL(110):
movl %eax, %esi /* Save exception bucket in esi */
- movl G(caml_exception_pointer), %edi /* SP of handler */
+ movl CAML_STATE(exception_pointer, %ebx), %edi /* SP of handler */
movl 0(%esp), %eax /* PC of raise */
leal 4(%esp), %edx /* SP of raise */
ALIGN_STACK(12)
call G(caml_stash_backtrace)
movl %esi, %eax /* Recover exception bucket */
movl %edi, %esp
- popl G(caml_exception_pointer); CFI_ADJUST(-4)
+ popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
CFI_ENDPROC
FUNCTION(caml_raise_exception)
CFI_STARTPROC
- testl $1, G(caml_backtrace_active)
+ movl G(Caml_state), %ebx
+ testl $1, CAML_STATE(backtrace_active, %ebx)
jne LBL(112)
- movl 4(%esp), %eax
- movl G(caml_exception_pointer), %esp
- popl G(caml_exception_pointer); CFI_ADJUST(-4)
+ movl 8(%esp), %eax
+ movl CAML_STATE(exception_pointer, %ebx), %esp
+ popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
LBL(112):
- movl 4(%esp), %esi /* Save exception bucket in esi */
+ movl 8(%esp), %esi /* Save exception bucket in esi */
ALIGN_STACK(12)
- pushl G(caml_exception_pointer); CFI_ADJUST(4) /* 4: sp of handler */
- pushl G(caml_bottom_of_stack); CFI_ADJUST(4) /* 3: sp of raise */
- pushl G(caml_last_return_address); CFI_ADJUST(4)/* 2: pc of raise */
- pushl %esi; CFI_ADJUST(4) /* 1: exception bucket */
+ /* 4: sp of handler */
+ pushl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(4)
+ /* 3: sp of raise */
+ pushl CAML_STATE(bottom_of_stack, %ebx); CFI_ADJUST(4)
+ /* 2: pc of raise */
+ pushl CAML_STATE(last_return_address, %ebx); CFI_ADJUST(4)
+ /* 1: exception bucket */
+ pushl %esi; CFI_ADJUST(4)
call G(caml_stash_backtrace)
movl %esi, %eax /* Recover exception bucket */
- movl G(caml_exception_pointer), %esp
- popl G(caml_exception_pointer); CFI_ADJUST(-4)
+ movl CAML_STATE(exception_pointer, %ebx), %esp
+ popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
CFI_ENDPROC
/* Callback from C to OCaml */
-FUNCTION(caml_callback_exn)
+FUNCTION(caml_callback_asm)
CFI_STARTPROC
/* Save callee-save registers */
pushl %ebx; CFI_ADJUST(4)
pushl %edi; CFI_ADJUST(4)
pushl %ebp; CFI_ADJUST(4)
/* Initial loading of arguments */
- movl 20(%esp), %ebx /* closure */
- movl 24(%esp), %eax /* argument */
+ movl 24(%esp), %ebx /* arg2: closure */
+ movl 28(%esp), %edi /* arguments array */
+ movl 0(%edi), %eax /* arg1: argument */
movl 0(%ebx), %esi /* code pointer */
jmp LBL(106)
CFI_ENDPROC
- ENDFUNCTION(caml_callback_exn)
+ENDFUNCTION(caml_callback_asm)
-FUNCTION(caml_callback2_exn)
+FUNCTION(caml_callback2_asm)
CFI_STARTPROC
/* Save callee-save registers */
pushl %ebx; CFI_ADJUST(4)
pushl %edi; CFI_ADJUST(4)
pushl %ebp; CFI_ADJUST(4)
/* Initial loading of arguments */
- movl 20(%esp), %ecx /* closure */
- movl 24(%esp), %eax /* first argument */
- movl 28(%esp), %ebx /* second argument */
+ movl 24(%esp), %ecx /* arg3: closure */
+ movl 28(%esp), %edi /* arguments array */
+ movl 0(%edi), %eax /* arg1: first argument */
+ movl 4(%edi), %ebx /* arg2: second argument */
movl $ G(caml_apply2), %esi /* code pointer */
jmp LBL(106)
CFI_ENDPROC
- ENDFUNCTION(caml_callback2_exn)
+ENDFUNCTION(caml_callback2_asm)
-FUNCTION(caml_callback3_exn)
+FUNCTION(caml_callback3_asm)
CFI_STARTPROC
/* Save callee-save registers */
pushl %ebx; CFI_ADJUST(4)
pushl %edi; CFI_ADJUST(4)
pushl %ebp; CFI_ADJUST(4)
/* Initial loading of arguments */
- movl 20(%esp), %edx /* closure */
- movl 24(%esp), %eax /* first argument */
- movl 28(%esp), %ebx /* second argument */
- movl 32(%esp), %ecx /* third argument */
+ movl 24(%esp), %edx /* arg4: closure */
+ movl 28(%esp), %edi /* arguments array */
+ movl 0(%edi), %eax /* arg1: first argument */
+ movl 4(%edi), %ebx /* arg2: second argument */
+ movl 8(%edi), %ecx /* arg3: third argument */
movl $ G(caml_apply3), %esi /* code pointer */
jmp LBL(106)
CFI_ENDPROC
- ENDFUNCTION(caml_callback3_exn)
+ENDFUNCTION(caml_callback3_asm)
FUNCTION(caml_ml_array_bound_error)
CFI_STARTPROC
ffree %st(6)
ffree %st(7)
/* Record lowest stack address and return address */
+ movl G(Caml_state), %ebx
movl (%esp), %edx
- movl %edx, G(caml_last_return_address)
+ movl %edx, CAML_STATE(last_return_address, %ebx)
leal 4(%esp), %edx
- movl %edx, G(caml_bottom_of_stack)
+ movl %edx, CAML_STATE(bottom_of_stack, %ebx)
/* Re-align the stack */
andl $-16, %esp
/* Branch to [caml_array_bound_error] (never returns) */
EXTERN _caml_apply3: PROC
EXTERN _caml_program: PROC
EXTERN _caml_array_bound_error: PROC
- EXTERN _caml_young_limit: DWORD
- EXTERN _caml_young_ptr: DWORD
- EXTERN _caml_bottom_of_stack: DWORD
- EXTERN _caml_last_return_address: DWORD
- EXTERN _caml_gc_regs: DWORD
- EXTERN _caml_exception_pointer: DWORD
- EXTERN _caml_backtrace_pos: DWORD
- EXTERN _caml_backtrace_active: DWORD
EXTERN _caml_stash_backtrace: PROC
+ EXTERN _Caml_state: DWORD
; Allocation
.CODE
+ PUBLIC _caml_call_gc
PUBLIC _caml_alloc1
PUBLIC _caml_alloc2
PUBLIC _caml_alloc3
PUBLIC _caml_allocN
- PUBLIC _caml_call_gc
+
+INCLUDE domain_state32.inc
_caml_call_gc:
; Record lowest stack address and return address
- mov eax, [esp]
- mov _caml_last_return_address, eax
- lea eax, [esp+4]
- mov _caml_bottom_of_stack, eax
+ push ebx ; make a tmp reg
+ mov ebx, _Caml_state
+ mov eax, [esp+4]
+ Store_last_return_address ebx, eax
+ lea eax, [esp+8]
+ Store_bottom_of_stack ebx, eax
+ pop ebx
; Save all regs used by the code generator
L105: push ebp
push edi
push ecx
push ebx
push eax
- mov _caml_gc_regs, esp
+ mov ebx, _Caml_state
+ Store_gc_regs ebx, esp
; Call the garbage collector
call _caml_garbage_collection
; Restore all regs used by the code generator
ALIGN 4
_caml_alloc1:
- mov eax, _caml_young_ptr
+ push ebx ; make a tmp reg
+ mov ebx, _Caml_state
+ Load_young_ptr ebx, eax
sub eax, 8
- mov _caml_young_ptr, eax
- cmp eax, _caml_young_limit
+ Cmp_young_limit ebx, eax
jb L100
+ Store_young_ptr ebx, eax
+ pop ebx
ret
-L100: mov eax, [esp]
- mov _caml_last_return_address, eax
- lea eax, [esp+4]
- mov _caml_bottom_of_stack, eax
+L100: mov eax, [esp + 4]
+ Store_last_return_address ebx, eax
+ lea eax, [esp+8]
+ Store_bottom_of_stack ebx, eax
+ pop ebx
call L105
jmp _caml_alloc1
ALIGN 4
_caml_alloc2:
- mov eax, _caml_young_ptr
+ push ebx ; make a tmp reg
+ mov ebx, _Caml_state
+ Load_young_ptr ebx, eax
sub eax, 12
- mov _caml_young_ptr, eax
- cmp eax, _caml_young_limit
+ Cmp_young_limit ebx, eax
jb L101
+ Store_young_ptr ebx, eax
+ pop ebx
ret
-L101: mov eax, [esp]
- mov _caml_last_return_address, eax
- lea eax, [esp+4]
- mov _caml_bottom_of_stack, eax
+L101: mov eax, [esp+4]
+ Store_last_return_address ebx, eax
+ lea eax, [esp+8]
+ Store_bottom_of_stack ebx, eax
+ pop ebx
call L105
jmp _caml_alloc2
ALIGN 4
_caml_alloc3:
- mov eax, _caml_young_ptr
+ push ebx ; make a tmp reg
+ mov ebx, _Caml_state
+ Load_young_ptr ebx, eax
sub eax, 16
- mov _caml_young_ptr, eax
- cmp eax, _caml_young_limit
+ Cmp_young_limit ebx, eax
jb L102
+ Store_young_ptr ebx, eax
+ pop ebx
ret
-L102: mov eax, [esp]
- mov _caml_last_return_address, eax
- lea eax, [esp+4]
- mov _caml_bottom_of_stack, eax
+L102: mov eax, [esp+4]
+ Store_last_return_address ebx, eax
+ lea eax, [esp+8]
+ Store_bottom_of_stack ebx, eax
+ pop ebx
call L105
jmp _caml_alloc3
+
ALIGN 4
_caml_allocN:
- sub eax, _caml_young_ptr ; eax = size - young_ptr
- neg eax ; eax = young_ptr - size
- cmp eax, _caml_young_limit
+ push eax ; Save desired size
+ push ebx ; Make a tmp reg
+ mov ebx, _Caml_state
+ Sub_young_ptr ebx, eax ; eax = size - young_ptr
+ neg eax ; eax = young_ptr - size
+ Cmp_young_limit ebx, eax
jb L103
- mov _caml_young_ptr, eax
+ Store_young_ptr ebx, eax
+ pop ebx
+ add esp, 4 ; drop desired size
ret
-L103: sub eax, _caml_young_ptr ; eax = - size
- neg eax ; eax = size
- push eax ; save desired size
- sub _caml_young_ptr, eax ; must update young_ptr
- mov eax, [esp+4]
- mov _caml_last_return_address, eax
- lea eax, [esp+8]
- mov _caml_bottom_of_stack, eax
+L103: mov eax, [esp+8]
+ Store_last_return_address ebx, eax
+ lea eax, [esp+12]
+ Store_bottom_of_stack ebx, eax
+ pop ebx
call L105
pop eax ; recover desired size
jmp _caml_allocN
ALIGN 4
_caml_c_call:
; Record lowest stack address and return address
+ ; ecx and edx are destroyed at C call. Use them as temp.
+ mov ecx, _Caml_state
mov edx, [esp]
- mov _caml_last_return_address, edx
+ Store_last_return_address ecx, edx
lea edx, [esp+4]
- mov _caml_bottom_of_stack, edx
+ Store_bottom_of_stack ecx, edx
; Call the function (address in %eax)
jmp eax
; Code shared between caml_start_program and callback*
L106:
+ mov edi, _Caml_state
; Build a callback link
- push _caml_gc_regs
- push _caml_last_return_address
- push _caml_bottom_of_stack
+ Push_gc_regs edi
+ Push_last_return_address edi
+ Push_bottom_of_stack edi
; Build an exception handler
push L108
- push _caml_exception_pointer
- mov _caml_exception_pointer, esp
+ Push_exception_pointer edi
+ Store_exception_pointer edi, esp
; Call the OCaml code
call esi
L107:
+ mov edi, _Caml_state
; Pop the exception handler
- pop _caml_exception_pointer
- pop esi ; dummy register
+ Pop_exception_pointer edi
+ add esp, 4
L109:
+ mov edi, _Caml_state
; Pop the callback link, restoring the global variables
; used by caml_c_call
- pop _caml_bottom_of_stack
- pop _caml_last_return_address
- pop _caml_gc_regs
+ Pop_bottom_of_stack edi
+ Pop_last_return_address edi
+ Pop_gc_regs edi
; Restore callee-save registers.
pop ebp
pop edi
PUBLIC _caml_raise_exn
ALIGN 4
_caml_raise_exn:
- test _caml_backtrace_active, 1
+ mov ebx, _Caml_state
+ Load_backtrace_active ebx, ecx
+ test ecx, 1
jne L110
- mov esp, _caml_exception_pointer
- pop _caml_exception_pointer
+ Load_exception_pointer ebx, esp
+ Pop_exception_pointer ebx
ret
L110:
mov esi, eax ; Save exception bucket in esi
- mov edi, _caml_exception_pointer ; SP of handler
+ Load_exception_pointer ebx, edi ; SP of handler
mov eax, [esp] ; PC of raise
- lea edx, [esp+4]
+ lea edx, [esp+4] ; SP of raise
push edi ; arg 4: SP of handler
push edx ; arg 3: SP of raise
push eax ; arg 2: PC of raise
call _caml_stash_backtrace
mov eax, esi ; recover exception bucket
mov esp, edi ; cut the stack
- pop _caml_exception_pointer
+ Pop_exception_pointer ebx
ret
; Raise an exception from C
PUBLIC _caml_raise_exception
ALIGN 4
_caml_raise_exception:
- test _caml_backtrace_active, 1
+ mov ebx, _Caml_state
+ Load_backtrace_active ebx, ecx
+ test ecx, 1
jne L112
- mov eax, [esp+4]
- mov esp, _caml_exception_pointer
- pop _caml_exception_pointer
+ mov eax, [esp+8]
+ Load_exception_pointer ebx, esp
+ Pop_exception_pointer ebx
ret
L112:
- mov esi, [esp+4] ; Save exception bucket in esi
- push _caml_exception_pointer ; arg 4: SP of handler
- push _caml_bottom_of_stack ; arg 3: SP of raise
- push _caml_last_return_address ; arg 2: PC of raise
+ mov esi, [esp+8] ; Save exception bucket in esi
+ Push_exception_pointer ebx ; arg 4: SP of handler
+ Push_bottom_of_stack ebx ; arg 3: SP of raise
+ Push_last_return_address ebx ; arg 2: PC of raise
push esi ; arg 1: exception bucket
call _caml_stash_backtrace
mov eax, esi ; recover exception bucket
- mov esp, _caml_exception_pointer ; cut the stack
- pop _caml_exception_pointer
+ Load_exception_pointer ebx, esp ; cut the stack
+ Pop_exception_pointer ebx
ret
; Callback from C to OCaml
- PUBLIC _caml_callback_exn
+ PUBLIC _caml_callback_asm
ALIGN 4
-_caml_callback_exn:
+_caml_callback_asm:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
- mov ebx, [esp+20] ; closure
- mov eax, [esp+24] ; argument
+ mov ebx, [esp+24] ; arg2: closure
+ mov edi, [esp+28] ; arguments array
+ mov eax, [edi] ; arg1: argument
mov esi, [ebx] ; code pointer
jmp L106
- PUBLIC _caml_callback2_exn
+ PUBLIC _caml_callback2_asm
ALIGN 4
-_caml_callback2_exn:
+_caml_callback2_asm:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
- mov ecx, [esp+20] ; closure
- mov eax, [esp+24] ; first argument
- mov ebx, [esp+28] ; second argument
+ mov ecx, [esp+24] ; arg3: closure
+ mov edi, [esp+28] ; arguments array
+ mov eax, [edi] ; arg1: first argument
+ mov ebx, [edi+4] ; arg2: second argument
mov esi, offset _caml_apply2 ; code pointer
jmp L106
- PUBLIC _caml_callback3_exn
+ PUBLIC _caml_callback3_asm
ALIGN 4
-_caml_callback3_exn:
+_caml_callback3_asm:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
- mov edx, [esp+20] ; closure
- mov eax, [esp+24] ; first argument
- mov ebx, [esp+28] ; second argument
- mov ecx, [esp+32] ; third argument
+ mov edx, [esp+24] ; arg4: closure
+ mov edi, [esp+28] ; arguments array
+ mov eax, [edi] ; arg1: first argument
+ mov ebx, [edi+4] ; arg2: second argument
+ mov ecx, [edi+8] ; arg3: third argument
mov esi, offset _caml_apply3 ; code pointer
jmp L106
fprintf (f, "=code@%ld", (long) ((code_t) v - prog));
else if (Is_long (v))
fprintf (f, "=long%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val (v));
- else if ((void*)v >= (void*)caml_stack_low
- && (void*)v < (void*)caml_stack_high)
- fprintf (f, "=stack_%ld", (long) ((intnat*)caml_stack_high - (intnat*)v));
+ else if ((void*)v >= (void*)Caml_state->stack_low
+ && (void*)v < (void*)Caml_state->stack_high)
+ fprintf (f, "=stack_%ld",
+ (long) ((intnat*)Caml_state->stack_high - (intnat*)v));
else if (Is_block (v)) {
int s = Wosize_val (v);
int tg = Tag_val (v);
fprintf (f, "accu=");
caml_trace_value_file (accu, prog, proglen, f);
fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%ld:",
- (intnat) sp, (long) (caml_stack_high - sp));
- for (p = sp, i = 0; i < 12 + (1 << caml_trace_level) && p < caml_stack_high;
+ (intnat) sp, (long) (Caml_state->stack_high - sp));
+ for (p = sp, i = 0;
+ i < 12 + (1 << caml_trace_level) && p < Caml_state->stack_high;
p++, i++) {
- fprintf (f, "\n[%ld] ", (long) (caml_stack_high - p));
+ fprintf (f, "\n[%ld] ", (long) (Caml_state->stack_high - p));
caml_trace_value_file (*p, prog, proglen, f);
};
putc ('\n', f);
#include "caml/io.h"
#include "caml/md5.h"
#include "caml/memory.h"
+#include "caml/memprof.h"
#include "caml/mlvalues.h"
#include "caml/misc.h"
#include "caml/reverse.h"
+#include "caml/signals.h"
+
static unsigned char * intern_src;
/* Reading pointer in block holding input data. */
if (ops->finalize != NULL && Is_young(v)) {
/* Remember that the block has a finalizer. */
- add_to_custom_table (&caml_custom_table, v, 0, 1);
+ add_to_custom_table (Caml_state->custom_table, v, 0, 1);
}
intern_dest += 1 + size;
if (wosize <= Max_young_wosize){
if (wosize == 0){
intern_block = Atom (String_tag);
- } else {
- intern_block = caml_alloc_small (wosize, String_tag);
+ }else{
+#define Setup_for_gc
+#define Restore_after_gc
+ Alloc_small_no_track(intern_block, wosize, String_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
}
}else{
- intern_block = caml_alloc_shr_no_raise (wosize, String_tag);
+ intern_block = caml_alloc_shr_no_track_noexc (wosize, String_tag);
/* do not do the urgent_gc check here because it might darken
intern_block into gray and break the intern_color assertion below */
if (intern_block == 0) {
CAMLassert(intern_obj_table == NULL);
}
-static void intern_add_to_heap(mlsize_t whsize)
+static header_t* intern_add_to_heap(mlsize_t whsize)
{
+ header_t* res = NULL;
/* Add new heap chunk to heap if needed */
if (intern_extra_block != NULL) {
/* If heap chunk not filled totally, build free block at end */
}
caml_allocated_words +=
Wsize_bsize ((char *) intern_dest - intern_extra_block);
- caml_add_to_heap(intern_extra_block);
+ if(caml_add_to_heap(intern_extra_block) != 0) {
+ intern_cleanup();
+ caml_raise_out_of_memory();
+ }
+ res = (header_t*)intern_extra_block;
intern_extra_block = NULL; // To prevent intern_cleanup freeing it
- } else {
+ } else if(intern_block != 0) { /* [intern_block = 0] when [whsize = 0] */
+ res = Hp_val(intern_block);
intern_block = 0; // To prevent intern_cleanup rewriting its header
}
+ return res;
+}
+
+static value intern_end(value res, mlsize_t whsize)
+{
+ CAMLparam1(res);
+ header_t *block = intern_add_to_heap(whsize);
+ header_t *blockend = intern_dest;
+
+ /* Free everything */
+ intern_cleanup();
+
+ /* Memprof tracking has to be done here, because unmarshalling can
+ still fail until now. */
+ if(block != NULL)
+ caml_memprof_track_interned(block, blockend);
+
+ // Give gc a chance to run, and run memprof callbacks
+ caml_process_pending_actions();
+
+ CAMLreturn(res);
}
/* Parsing the header */
intern_alloc(h.whsize, h.num_objects, outside_heap);
/* Fill it in */
intern_rec(&res);
- if (!outside_heap) {
- intern_add_to_heap(h.whsize);
- } else {
+ if (!outside_heap)
+ return intern_end(res, h.whsize);
+ else {
caml_disown_for_heap(intern_extra_block);
intern_extra_block = NULL;
intern_block = 0;
+ /* Free everything */
+ intern_cleanup();
+ return caml_check_urgent_gc(res);
}
- /* Free everything */
- intern_cleanup();
- return caml_check_urgent_gc(res);
}
value caml_input_val(struct channel* chan)
intern_src = &Byte_u(str, ofs + h.header_len); /* If a GC occurred */
/* Fill it in */
intern_rec(&obj);
- intern_add_to_heap(h.whsize);
- /* Free everything */
- intern_cleanup();
- CAMLreturn (caml_check_urgent_gc(obj));
+ CAMLreturn (intern_end(obj, h.whsize));
}
CAMLprim value caml_input_value_from_string(value str, value ofs)
intern_alloc(h->whsize, h->num_objects, 0);
/* Fill it in */
intern_rec(&obj);
- intern_add_to_heap(h->whsize);
- /* Free internal data structures */
- intern_cleanup();
- return caml_check_urgent_gc(obj);
+ return (intern_end(obj, h->whsize));
}
CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs)
sp the stack pointer (grows downward)
accu the accumulator
env heap-allocated environment
- caml_trapsp pointer to the current trap frame
+ Caml_state->trapsp pointer to the current trap frame
extra_args number of extra arguments provided by the caller
-sp is a local copy of the global variable caml_extern_sp. */
+sp is a local copy of the global variable Caml_state->extern_sp. */
/* Instruction decoding */
/* GC interface */
+#undef Alloc_small_origin
+// Do call asynchronous callbacks from allocation functions
+#define Alloc_small_origin CAML_FROM_CAML
#define Setup_for_gc \
- { sp -= 2; sp[0] = accu; sp[1] = env; caml_extern_sp = sp; }
+ { sp -= 2; sp[0] = accu; sp[1] = env; Caml_state->extern_sp = sp; }
#define Restore_after_gc \
{ accu = sp[0]; env = sp[1]; sp += 2; }
+
+/* We store [pc+1] in the stack so that, in case of an exception, the
+ first backtrace slot points to the event following the C call
+ instruction. */
#define Setup_for_c_call \
- { saved_pc = pc; *--sp = env; caml_extern_sp = sp; }
+ { sp -= 2; sp[0] = env; sp[1] = (value)(pc + 1); Caml_state->extern_sp = sp; }
#define Restore_after_c_call \
- { sp = caml_extern_sp; env = *sp++; saved_pc = NULL; }
+ { sp = Caml_state->extern_sp; env = *sp; sp += 2; }
-/* An event frame must look like accu + a C_CALL frame + a RETURN 1 frame */
+/* For VM threads purposes, an event frame must look like accu + a
+ C_CALL frame + a RETURN 1 frame.
+ TODO: now that VM threads are gone, we could get rid of that. But
+ we need to make sure that this is not used elsewhere. */
#define Setup_for_event \
{ sp -= 6; \
sp[0] = accu; /* accu */ \
sp[3] = (value) pc; /* RETURN frame: saved return address */ \
sp[4] = env; /* RETURN frame: saved environment */ \
sp[5] = Val_long(extra_args); /* RETURN frame: saved extra args */ \
- caml_extern_sp = sp; }
+ Caml_state->extern_sp = sp; }
#define Restore_after_event \
- { sp = caml_extern_sp; accu = sp[0]; \
+ { sp = Caml_state->extern_sp; accu = sp[0]; \
pc = (code_t) sp[3]; env = sp[4]; extra_args = Long_val(sp[5]); \
sp += 6; }
{ sp -= 4; \
sp[0] = accu; sp[1] = (value)(pc - 1); \
sp[2] = env; sp[3] = Val_long(extra_args); \
- caml_extern_sp = sp; }
+ Caml_state->extern_sp = sp; }
#define Restore_after_debugger { sp += 4; }
#ifdef THREADED_CODE
#define Restart_curr_instr \
- goto *(jumptable[caml_saved_code[pc - 1 - caml_start_code]])
+ goto *((void*)(jumptbl_base + caml_debugger_saved_instruction(pc - 1)))
#else
#define Restart_curr_instr \
- curr_instr = caml_saved_code[pc - 1 - caml_start_code]; \
+ curr_instr = caml_debugger_saved_instruction(pc - 1); \
goto dispatch_instr
#endif
+#define Check_trap_barrier \
+ if (Caml_state->trapsp >= Caml_state->trap_barrier) \
+ caml_debugger(TRAP_BARRIER, Val_unit)
+
/* Register optimization.
Some compilers underestimate the use of the local variables representing
the abstract machine registers, and don't put them in hardware registers,
intnat extra_args;
struct longjmp_buffer * initial_external_raise;
intnat initial_sp_offset;
- /* volatile ensures that initial_local_roots and saved_pc
+ /* volatile ensures that initial_local_roots
will keep correct value across longjmp */
struct caml__roots_block * volatile initial_local_roots;
- volatile code_t saved_pc = NULL;
struct longjmp_buffer raise_buf;
#ifndef THREADED_CODE
opcode_t curr_instr;
#if defined(THREADED_CODE) && defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
jumptbl_base = Jumptbl_base;
#endif
- initial_local_roots = caml_local_roots;
- initial_sp_offset = (char *) caml_stack_high - (char *) caml_extern_sp;
- initial_external_raise = caml_external_raise;
+ initial_local_roots = Caml_state->local_roots;
+ initial_sp_offset =
+ (char *) Caml_state->stack_high - (char *) Caml_state->extern_sp;
+ initial_external_raise = Caml_state->external_raise;
caml_callback_depth++;
- saved_pc = NULL;
if (sigsetjmp(raise_buf.buf, 0)) {
- caml_local_roots = initial_local_roots;
- sp = caml_extern_sp;
- accu = caml_exn_bucket;
- pc = saved_pc; saved_pc = NULL;
- if (pc != NULL) pc += 2;
- /* +2 adjustment for the sole purpose of backtraces */
- goto raise_exception;
+ Caml_state->local_roots = initial_local_roots;
+ sp = Caml_state->extern_sp;
+ accu = Caml_state->exn_bucket;
+
+ Check_trap_barrier;
+ if (Caml_state->backtrace_active) {
+ /* pc has already been pushed on the stack when calling the C
+ function that raised the exception. No need to push it again
+ here. */
+ caml_stash_backtrace(accu, sp, 0);
+ }
+ goto raise_notrace;
}
- caml_external_raise = &raise_buf;
+ Caml_state->external_raise = &raise_buf;
- sp = caml_extern_sp;
+ sp = Caml_state->extern_sp;
pc = prog;
extra_args = 0;
env = Atom(0);
#ifdef DEBUG
next_instr:
if (caml_icount-- == 0) caml_stop_here ();
- CAMLassert(sp >= caml_stack_low);
- CAMLassert(sp <= caml_stack_high);
+ CAMLassert(sp >= Caml_state->stack_low);
+ CAMLassert(sp <= Caml_state->stack_high);
#endif
goto *(void *)(jumptbl_base + *pc++); /* Jump to the first instruction */
#else
caml_trace_accu_sp_file(accu,sp,prog,prog_size,stdout);
fflush(stdout);
};
- CAMLassert(sp >= caml_stack_low);
- CAMLassert(sp <= caml_stack_high);
+ CAMLassert(sp >= Caml_state->stack_low);
+ CAMLassert(sp <= Caml_state->stack_high);
#endif
curr_instr = *pc++;
Instruct(PUSHTRAP):
sp -= 4;
Trap_pc(sp) = pc + *pc;
- Trap_link(sp) = caml_trapsp;
+ Trap_link(sp) = Caml_state->trapsp;
sp[2] = env;
sp[3] = Val_long(extra_args);
- caml_trapsp = sp;
+ Caml_state->trapsp = sp;
pc++;
Next;
handler triggers an exception, the exception is trapped
by the current try...with, not the enclosing one. */
pc--; /* restart the POPTRAP after processing the signal */
- goto process_signal;
+ goto process_actions;
}
- caml_trapsp = Trap_link(sp);
+ Caml_state->trapsp = Trap_link(sp);
sp += 4;
Next;
Instruct(RAISE_NOTRACE):
- if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER);
+ Check_trap_barrier;
goto raise_notrace;
Instruct(RERAISE):
- if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER);
- if (caml_backtrace_active) caml_stash_backtrace(accu, pc, sp, 1);
+ Check_trap_barrier;
+ if (Caml_state->backtrace_active) {
+ *--sp = (value)(pc - 1);
+ caml_stash_backtrace(accu, sp, 1);
+ }
goto raise_notrace;
Instruct(RAISE):
- raise_exception:
- if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER);
- if (caml_backtrace_active) caml_stash_backtrace(accu, pc, sp, 0);
+ Check_trap_barrier;
+ if (Caml_state->backtrace_active) {
+ *--sp = (value)(pc - 1);
+ caml_stash_backtrace(accu, sp, 0);
+ }
raise_notrace:
- if ((char *) caml_trapsp
- >= (char *) caml_stack_high - initial_sp_offset) {
- caml_external_raise = initial_external_raise;
- caml_extern_sp = (value *) ((char *) caml_stack_high
+ if ((char *) Caml_state->trapsp
+ >= (char *) Caml_state->stack_high - initial_sp_offset) {
+ Caml_state->external_raise = initial_external_raise;
+ Caml_state->extern_sp = (value *) ((char *) Caml_state->stack_high
- initial_sp_offset);
caml_callback_depth--;
return Make_exception_result(accu);
}
- sp = caml_trapsp;
+ sp = Caml_state->trapsp;
pc = Trap_pc(sp);
- caml_trapsp = Trap_link(sp);
+ Caml_state->trapsp = Trap_link(sp);
env = sp[2];
extra_args = Long_val(sp[3]);
sp += 4;
/* Stack checks */
check_stacks:
- if (sp < caml_stack_threshold) {
- caml_extern_sp = sp;
+ if (sp < Caml_state->stack_threshold) {
+ Caml_state->extern_sp = sp;
caml_realloc_stack(Stack_threshold / sizeof(value));
- sp = caml_extern_sp;
+ sp = Caml_state->extern_sp;
}
/* Fall through CHECK_SIGNALS */
/* Signal handling */
Instruct(CHECK_SIGNALS): /* accu not preserved */
- if (caml_something_to_do) goto process_signal;
+ if (caml_something_to_do) goto process_actions;
Next;
- process_signal:
- caml_something_to_do = 0;
+ process_actions:
Setup_for_event;
- caml_process_event();
+ caml_process_pending_actions();
Restore_after_event;
Next;
Next;
Instruct(C_CALL2):
Setup_for_c_call;
- accu = Primitive(*pc)(accu, sp[1]);
+ accu = Primitive(*pc)(accu, sp[2]);
Restore_after_c_call;
sp += 1;
pc++;
Next;
Instruct(C_CALL3):
Setup_for_c_call;
- accu = Primitive(*pc)(accu, sp[1], sp[2]);
+ accu = Primitive(*pc)(accu, sp[2], sp[3]);
Restore_after_c_call;
sp += 2;
pc++;
Next;
Instruct(C_CALL4):
Setup_for_c_call;
- accu = Primitive(*pc)(accu, sp[1], sp[2], sp[3]);
+ accu = Primitive(*pc)(accu, sp[2], sp[3], sp[4]);
Restore_after_c_call;
sp += 3;
pc++;
Next;
Instruct(C_CALL5):
Setup_for_c_call;
- accu = Primitive(*pc)(accu, sp[1], sp[2], sp[3], sp[4]);
+ accu = Primitive(*pc)(accu, sp[2], sp[3], sp[4], sp[5]);
Restore_after_c_call;
sp += 4;
pc++;
int nargs = *pc++;
*--sp = accu;
Setup_for_c_call;
- accu = Primitive(*pc)(sp + 1, nargs);
+ accu = Primitive(*pc)(sp + 2, nargs);
Restore_after_c_call;
sp += nargs;
pc++;
/* Debugging and machine control */
Instruct(STOP):
- caml_external_raise = initial_external_raise;
- caml_extern_sp = sp;
+ Caml_state->external_raise = initial_external_raise;
+ Caml_state->extern_sp = sp;
caml_callback_depth--;
return accu;
Instruct(EVENT):
if (--caml_event_count == 0) {
Setup_for_debugger;
- caml_debugger(EVENT_COUNT);
+ caml_debugger(EVENT_COUNT, Val_unit);
Restore_after_debugger;
}
Restart_curr_instr;
Instruct(BREAK):
Setup_for_debugger;
- caml_debugger(BREAKPOINT);
+ caml_debugger(BREAKPOINT, Val_unit);
Restore_after_debugger;
Restart_curr_instr;
value *new;
CAMLassert (gray_vals_cur == gray_vals_end);
- if (gray_vals_size < caml_stat_heap_wsz / 32){
+ if (gray_vals_size < Caml_state->stat_heap_wsz / 32){
caml_gc_message (0x08, "Growing gray_vals to %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
(intnat) gray_vals_size * sizeof (value) / 512);
/* The variable child is not changed because it must be mark alive */
Field (v, i) = f;
if (Is_block (f) && Is_young (f) && !Is_young (child)){
- if(in_ephemeron){
- add_to_ephe_ref_table (&caml_ephe_ref_table, v, i);
- }else{
- add_to_ref_table (&caml_ref_table, &Field (v, i));
+ if(in_ephemeron) {
+ add_to_ephe_ref_table (Caml_state->ephe_ref_table, v, i);
+ } else {
+ add_to_ref_table (Caml_state->ref_table, &Field (v, i));
}
}
}
caml_gc_sweep_hp += Bhsize_hd (hd);
switch (Color_hd (hd)){
case Caml_white:
- if (Tag_hd (hd) == Custom_tag){
- void (*final_fun)(value) = Custom_ops_val(Val_hp(hp))->finalize;
- if (final_fun != NULL) final_fun(Val_hp(hp));
- }
- caml_gc_sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp));
+ caml_gc_sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp), limit);
break;
case Caml_blue:
/* Only the blocks of the free-list are blue. See [freelist.c]. */
chunk = Chunk_next (chunk);
if (chunk == NULL){
/* Sweeping is done. */
- ++ caml_stat_major_collections;
+ ++ Caml_state->stat_major_collections;
work = 0;
caml_gc_phase = Phase_idle;
caml_request_minor_gc ();
int i;
/*
Free memory at the start of the GC cycle (garbage + free list) (assumed):
- FM = caml_stat_heap_wsz * caml_percent_free
+ FM = Caml_state->stat_heap_wsz * caml_percent_free
/ (100 + caml_percent_free)
Assuming steady state and enforcing a constant allocation rate, then
Proportion of G consumed since the previous slice:
PH = caml_allocated_words / G
= caml_allocated_words * 3 * (100 + caml_percent_free)
- / (2 * caml_stat_heap_wsz * caml_percent_free)
+ / (2 * Caml_state->stat_heap_wsz * caml_percent_free)
Proportion of extra-heap resources consumed since the previous slice:
PE = caml_extra_heap_resources
Proportion of total work to do in this slice:
the P above.
Amount of marking work for the GC cycle:
- MW = caml_stat_heap_wsz * 100 / (100 + caml_percent_free)
- + caml_incremental_roots_count
+ MW = Caml_state->stat_heap_wsz * 100 / (100 + caml_percent_free)
+ + caml_incremental_roots_count
Amount of sweeping work for the GC cycle:
- SW = caml_stat_heap_wsz
+ SW = Caml_state->stat_heap_wsz
In order to finish marking with a non-empty free list, we will
use 40% of the time for marking, and 60% for sweeping.
Amount of marking work for a marking slice:
MS = P * MW / (40/100)
- MS = P * (caml_stat_heap_wsz * 250 / (100 + caml_percent_free)
+ MS = P * (Caml_state->stat_heap_wsz * 250
+ / (100 + caml_percent_free)
+ 2.5 * caml_incremental_roots_count)
Amount of sweeping work for a sweeping slice:
SS = P * SW / (60/100)
- SS = P * caml_stat_heap_wsz * 5 / 3
+ SS = P * Caml_state->stat_heap_wsz * 5 / 3
This slice will either mark MS words or sweep SS words.
*/
CAML_INSTR_SETUP (tmr, "major");
p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
- / caml_stat_heap_wsz / caml_percent_free / 2.0;
+ / Caml_state->stat_heap_wsz / caml_percent_free / 2.0;
if (caml_dependent_size > 0){
dp = (double) caml_dependent_allocated * (100 + caml_percent_free)
/ caml_dependent_size / caml_percent_free;
}else{
/* manual setting */
filt_p = (double) howmuch * 3.0 * (100 + caml_percent_free)
- / caml_stat_heap_wsz / caml_percent_free / 2.0;
+ / Caml_state->stat_heap_wsz / caml_percent_free / 2.0;
}
caml_major_work_credit += filt_p;
+ /* Limit work credit to 1.0 */
+ caml_major_work_credit = fmin(caml_major_work_credit, 1.0);
}
p = filt_p;
(intnat) (p * 1000000));
if (caml_gc_phase == Phase_idle){
- if (caml_young_ptr == caml_young_alloc_end){
+ if (Caml_state->young_ptr == Caml_state->young_alloc_end){
/* We can only start a major GC cycle if the minor allocation arena
is empty, otherwise we'd have to treat it as a set of roots. */
start_cycle ();
}
if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean){
- computed_work = (intnat) (p * ((double) caml_stat_heap_wsz * 250
+ computed_work = (intnat) (p * ((double) Caml_state->stat_heap_wsz * 250
/ (100 + caml_percent_free)
+ caml_incremental_roots_count));
}else{
- computed_work = (intnat) (p * caml_stat_heap_wsz * 5 / 3);
+ computed_work = (intnat) (p * Caml_state->stat_heap_wsz * 5 / 3);
}
caml_gc_message (0x40, "computed work = %"
ARCH_INTNAT_PRINTF_FORMAT "d words\n", computed_work);
for (i = 0; i < caml_major_window; i++) caml_major_ring[i] += p;
}
- caml_stat_major_words += caml_allocated_words;
+ Caml_state->stat_major_words += caml_allocated_words;
caml_allocated_words = 0;
caml_dependent_allocated = 0;
caml_extra_heap_resources = 0.0;
CAMLassert (caml_gc_phase == Phase_sweep);
while (caml_gc_phase == Phase_sweep) sweep_slice (LONG_MAX);
CAMLassert (caml_gc_phase == Phase_idle);
- caml_stat_major_words += caml_allocated_words;
+ Caml_state->stat_major_words += caml_allocated_words;
caml_allocated_words = 0;
}
if (caml_major_heap_increment > 1000){
incr = caml_major_heap_increment;
}else{
- incr = caml_stat_heap_wsz / 100 * caml_major_heap_increment;
+ incr = Caml_state->stat_heap_wsz / 100 * caml_major_heap_increment;
}
if (result < incr){
{
int i;
- caml_stat_heap_wsz = caml_clip_heap_chunk_wsz (Wsize_bsize (heap_size));
- caml_stat_top_heap_wsz = caml_stat_heap_wsz;
- CAMLassert (Bsize_wsize (caml_stat_heap_wsz) % Page_size == 0);
+ Caml_state->stat_heap_wsz =
+ caml_clip_heap_chunk_wsz (Wsize_bsize (heap_size));
+ Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
+ CAMLassert (Bsize_wsize (Caml_state->stat_heap_wsz) % Page_size == 0);
caml_heap_start =
- (char *) caml_alloc_for_heap (Bsize_wsize (caml_stat_heap_wsz));
+ (char *) caml_alloc_for_heap (Bsize_wsize (Caml_state->stat_heap_wsz));
if (caml_heap_start == NULL)
caml_fatal_error ("cannot allocate initial major heap");
Chunk_next (caml_heap_start) = NULL;
- caml_stat_heap_wsz = Wsize_bsize (Chunk_size (caml_heap_start));
- caml_stat_heap_chunks = 1;
- caml_stat_top_heap_wsz = caml_stat_heap_wsz;
+ Caml_state->stat_heap_wsz = Wsize_bsize (Chunk_size (caml_heap_start));
+ Caml_state->stat_heap_chunks = 1;
+ Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
if (caml_page_table_add(In_heap, caml_heap_start,
- caml_heap_start + Bsize_wsize (caml_stat_heap_wsz))
+ caml_heap_start + Bsize_wsize (Caml_state->stat_heap_wsz))
!= 0) {
caml_fatal_error ("cannot allocate initial page table");
}
caml_fl_init_merge ();
caml_make_free_blocks ((value *) caml_heap_start,
- caml_stat_heap_wsz, 1, Caml_white);
+ Caml_state->stat_heap_wsz, 1, Caml_white);
caml_gc_phase = Phase_idle;
gray_vals_size = 2048;
gray_vals = (value *) caml_stat_alloc_noexc (gray_vals_size * sizeof (value));
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/signals.h"
+#include "caml/memprof.h"
int caml_huge_fallback_count = 0;
/* Number of times that mmapping big pages fails and we fell back to small
return 0;
}
-
-/* Initialize the [alloc_for_heap] system.
- This function must be called exactly once, and it must be called
- before the first call to [alloc_for_heap].
- It returns 0 on success and -1 on failure.
-*/
-int caml_init_alloc_for_heap (void)
-{
- return 0;
-}
-
/* Allocate a block of the requested size, to be passed to
[caml_add_to_heap] later.
[request] will be rounded up to some implementation-dependent size.
caml_gc_message (0x04, "Growing heap to %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
- (Bsize_wsize (caml_stat_heap_wsz) + Chunk_size (m)) / 1024);
+ (Bsize_wsize (Caml_state->stat_heap_wsz) + Chunk_size (m)) / 1024);
/* Register block in page table */
if (caml_page_table_add(In_heap, m, m + Chunk_size(m)) != 0)
Chunk_next (m) = cur;
*last = m;
- ++ caml_stat_heap_chunks;
+ ++ Caml_state->stat_heap_chunks;
}
- caml_stat_heap_wsz += Wsize_bsize (Chunk_size (m));
- if (caml_stat_heap_wsz > caml_stat_top_heap_wsz){
- caml_stat_top_heap_wsz = caml_stat_heap_wsz;
+ Caml_state->stat_heap_wsz += Wsize_bsize (Chunk_size (m));
+ if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){
+ Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
}
return 0;
}
*/
if (chunk == caml_heap_start) return;
- caml_stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk));
+ Caml_state->stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk));
caml_gc_message (0x04, "Shrinking heap to %"
ARCH_INTNAT_PRINTF_FORMAT "uk words\n",
- caml_stat_heap_wsz / 1024);
+ Caml_state->stat_heap_wsz / 1024);
#ifdef DEBUG
{
}
#endif
- -- caml_stat_heap_chunks;
+ -- Caml_state->stat_heap_chunks;
/* Remove [chunk] from the list of chunks. */
cp = &caml_heap_start;
color_t caml_allocation_color (void *hp)
{
- if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean
- || (caml_gc_phase == Phase_sweep && (addr)hp >= (addr)caml_gc_sweep_hp)){
+ if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
+ (caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
return Caml_black;
}else{
CAMLassert (caml_gc_phase == Phase_idle
|| (caml_gc_phase == Phase_sweep
- && (addr)hp < (addr)caml_gc_sweep_hp));
+ && (char *)hp < (char *)caml_gc_sweep_hp));
return Caml_white;
}
}
-static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag,
+static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, int track,
int raise_oom, uintnat profinfo)
{
header_t *hp;
if (new_block == NULL) {
if (!raise_oom)
return 0;
- else if (caml_in_minor_collection)
+ else if (Caml_state->in_minor_collection)
caml_fatal_error ("out of memory");
else
caml_raise_out_of_memory ();
CAMLassert (Is_in_heap (Val_hp (hp)));
/* Inline expansion of caml_allocation_color. */
- if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean
- || (caml_gc_phase == Phase_sweep && (addr)hp >= (addr)caml_gc_sweep_hp)){
+ if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
+ (caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
Hd_hp (hp) = Make_header_with_profinfo (wosize, tag, Caml_black, profinfo);
}else{
CAMLassert (caml_gc_phase == Phase_idle
|| (caml_gc_phase == Phase_sweep
- && (addr)hp < (addr)caml_gc_sweep_hp));
+ && (char *)hp < (char *)caml_gc_sweep_hp));
Hd_hp (hp) = Make_header_with_profinfo (wosize, tag, Caml_white, profinfo);
}
CAMLassert (Hd_hp (hp)
== Make_header_with_profinfo (wosize, tag, caml_allocation_color (hp),
profinfo));
caml_allocated_words += Whsize_wosize (wosize);
- if (caml_allocated_words > caml_minor_heap_wsz){
+ if (caml_allocated_words > Caml_state->minor_heap_wsz){
CAML_INSTR_INT ("request_major/alloc_shr@", 1);
caml_request_major_slice ();
}
}
}
#endif
+ if(track)
+ caml_memprof_track_alloc_shr(Val_hp (hp));
return Val_hp (hp);
}
-CAMLexport value caml_alloc_shr_no_raise (mlsize_t wosize, tag_t tag)
-{
- return caml_alloc_shr_aux(wosize, tag, 0, 0);
-}
-
#ifdef WITH_PROFINFO
/* Use this to debug problems with macros... */
CAMLexport value caml_alloc_shr_with_profinfo (mlsize_t wosize, tag_t tag,
intnat profinfo)
{
- return caml_alloc_shr_aux(wosize, tag, 1, profinfo);
+ return caml_alloc_shr_aux(wosize, tag, 1, 1, profinfo);
}
-CAMLexport value caml_alloc_shr_preserving_profinfo (mlsize_t wosize,
- tag_t tag, header_t old_header)
+CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize,
+ tag_t tag, header_t old_header)
{
- return caml_alloc_shr_with_profinfo (wosize, tag, Profinfo_hd(old_header));
+ return caml_alloc_shr_aux (wosize, tag, 0, 1, Profinfo_hd(old_header));
}
#else
#define NO_PROFINFO 0
+
+CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize,
+ tag_t tag, header_t old_header)
+{
+ return caml_alloc_shr_aux (wosize, tag, 0, 1, NO_PROFINFO);
+}
#endif /* WITH_PROFINFO */
#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
return caml_alloc_shr_with_profinfo (wosize, tag,
caml_spacetime_my_profinfo (NULL, wosize));
}
+
+CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
+{
+ return caml_alloc_shr_aux (wosize, tag, 0, 0,
+ caml_spacetime_my_profinfo (NULL, wosize));
+}
#else
CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
{
- return caml_alloc_shr_aux (wosize, tag, 1, NO_PROFINFO);
+ return caml_alloc_shr_aux (wosize, tag, 1, 1, NO_PROFINFO);
+}
+
+CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
+{
+ return caml_alloc_shr_aux (wosize, tag, 0, 0, NO_PROFINFO);
}
#endif
CAMLassert(Is_in_heap_or_young(fp));
*fp = val;
if (!Is_young((value)fp) && Is_block (val) && Is_young (val)) {
- add_to_ref_table (&caml_ref_table, fp);
+ add_to_ref_table (Caml_state->ref_table, fp);
}
}
while the GC is in the marking phase
--> call [caml_darken] on the overwritten pointer so that the
major GC treats it as an additional root.
+
+ The logic implemented below is duplicated in caml_array_fill to
+ avoid repated calls to caml_modify and repeated tests on the
+ values. Don't forget to update caml_array_fill if the logic
+ below changes!
*/
value old;
}
/* Check for condition 1. */
if (Is_block(val) && Is_young(val)) {
- add_to_ref_table (&caml_ref_table, fp);
+ add_to_ref_table (Caml_state->ref_table, fp);
}
}
}
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Jacques-Henri Jourdan, projet Gallium, INRIA Paris */
+/* */
+/* Copyright 2016 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <math.h>
+#include <string.h>
+#include "caml/memprof.h"
+#include "caml/fail.h"
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/signals.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/backtrace_prim.h"
+#include "caml/weak.h"
+#include "caml/stack.h"
+#include "caml/misc.h"
+
+static uint32_t mt_state[624];
+static uint32_t mt_index;
+
+/* [lambda] is the mean number of samples for each allocated word (including
+ block headers). */
+static double lambda = 0;
+ /* Precomputed value of [1/log(1-lambda)], for fast sampling of
+ geometric distribution.
+ Dummy if [lambda = 0]. */
+static double one_log1m_lambda;
+
+int caml_memprof_suspended = 0;
+static intnat callstack_size = 0;
+static value memprof_callback = Val_unit;
+
+/* Pointer to the word following the next sample in the minor
+ heap. Equals [Caml_state->young_alloc_start] if no sampling is planned in
+ the current minor heap.
+ Invariant: [caml_memprof_young_trigger <= Caml_state->young_ptr].
+ */
+value* caml_memprof_young_trigger;
+
+/* Whether memprof has been initialized. */
+static int init = 0;
+
+/**** Statistical sampling ****/
+
+static double mt_generate_uniform(void)
+{
+ int i;
+ uint32_t y;
+
+ /* Mersenne twister PRNG */
+ if (mt_index == 624) {
+ for(i = 0; i < 227; i++) {
+ y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff);
+ mt_state[i] = mt_state[i+397] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
+ }
+ for(i = 227; i < 623; i++) {
+ y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff);
+ mt_state[i] = mt_state[i-227] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
+ }
+ y = (mt_state[623] & 0x80000000) + (mt_state[0] & 0x7fffffff);
+ mt_state[623] = mt_state[396] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
+ mt_index = 0;
+ }
+
+ y = mt_state[mt_index];
+ y = y ^ (y >> 11);
+ y = y ^ ((y << 7) & 0x9d2c5680);
+ y = y ^ ((y << 15) & 0xefc60000);
+ y = y ^ (y >> 18);
+
+ mt_index++;
+ return y*2.3283064365386962890625e-10 + /* 2^-32 */
+ 1.16415321826934814453125e-10; /* 2^-33 */
+}
+
+/* Simulate a geometric variable of parameter [lambda].
+ The result is clipped in [1..Max_long]
+ Requires [lambda > 0]. */
+static uintnat mt_generate_geom()
+{
+ /* We use the float versions of exp/log, since these functions are
+ significantly faster, and we really don't need much precision
+ here. The entropy contained in [next_mt_generate_geom] is anyway
+ bounded by the entropy provided by [mt_generate_uniform], which
+ is 32bits. */
+ double res = 1 + logf(mt_generate_uniform()) * one_log1m_lambda;
+ if (res > Max_long) return Max_long;
+ return (uintnat)res;
+}
+
+static uintnat next_mt_generate_binom;
+/* Simulate a binomial variable of parameters [len] and [lambda].
+ This sampling algorithm has running time linear with [len *
+ lambda]. We could use more a involved algorithm, but this should
+ be good enough since, in the average use case, [lambda] <= 0.01 and
+ therefore the generation of the binomial variable is amortized by
+ the initialialization of the corresponding block.
+
+ If needed, we could use algorithm BTRS from the paper:
+ Hormann, Wolfgang. "The generation of binomial random variates."
+ Journal of statistical computation and simulation 46.1-2 (1993), pp101-110.
+
+ Requires [lambda > 0] and [len < Max_long].
+ */
+static uintnat mt_generate_binom(uintnat len)
+{
+ uintnat res;
+ for(res = 0; next_mt_generate_binom < len; res++)
+ next_mt_generate_binom += mt_generate_geom();
+ next_mt_generate_binom -= len;
+ return res;
+}
+
+/**** Interface with the OCaml code. ****/
+
+static void purge_postponed_queue(void);
+
+CAMLprim value caml_memprof_set(value v)
+{
+ CAMLparam1(v);
+ double l = Double_val(Field(v, 0));
+ intnat sz = Long_val(Field(v, 1));
+
+ if (sz < 0 || !(l >= 0.) || l > 1.) /* Checks that [l] is not NAN. */
+ caml_invalid_argument("caml_memprof_set");
+
+ /* This call to [caml_memprof_set] may stop sampling or change the
+ callback. We have to make sure that the postponed queue is empty
+ before continuing. */
+ if (!caml_memprof_suspended)
+ caml_raise_if_exception(caml_memprof_handle_postponed_exn());
+ else
+ /* But if we are currently running a callback, there is nothing
+ else we can do than purging the queue. */
+ purge_postponed_queue();
+
+ if (!init) {
+ int i;
+ init = 1;
+
+ mt_index = 624;
+ mt_state[0] = 42;
+ for(i = 1; i < 624; i++)
+ mt_state[i] = 0x6c078965 * (mt_state[i-1] ^ (mt_state[i-1] >> 30)) + i;
+
+ caml_register_generational_global_root(&memprof_callback);
+ }
+
+ lambda = l;
+ if (l > 0) {
+ one_log1m_lambda = l == 1 ? 0 : 1/caml_log1p(-l);
+ next_mt_generate_binom = mt_generate_geom();
+ }
+
+ caml_memprof_renew_minor_sample();
+
+ callstack_size = sz;
+
+ caml_modify_generational_global_root(&memprof_callback, Field(v, 2));
+
+ CAMLreturn(Val_unit);
+}
+
+/* Cf. Gc.Memprof.alloc_kind */
+enum ml_alloc_kind {
+ Minor = Val_long(0),
+ Major = Val_long(1),
+ Unmarshalled = Val_long(2)
+};
+
+/* When we call do_callback_exn, we suspend/resume sampling. In order
+ to avoid a systematic unnecessary polling after each memprof
+ callback, we do not call [caml_set_action_pending] when resuming.
+ Therefore, any call to [do_callback_exn] has to also make sure the
+ postponed queue will be handled fully at some point. */
+static value do_callback_exn(tag_t tag, uintnat wosize, uintnat occurrences,
+ value callstack, enum ml_alloc_kind cb_kind)
+{
+ CAMLparam1(callstack);
+ CAMLlocal1(sample_info);
+ value res; /* Not a root, can be an exception result. */
+ CAMLassert(occurrences > 0 && !caml_memprof_suspended);
+
+ caml_memprof_suspended = 1;
+
+ sample_info = caml_alloc_small(5, 0);
+ Field(sample_info, 0) = Val_long(occurrences);
+ Field(sample_info, 1) = cb_kind;
+ Field(sample_info, 2) = Val_long(tag);
+ Field(sample_info, 3) = Val_long(wosize);
+ Field(sample_info, 4) = callstack;
+
+ res = caml_callback_exn(memprof_callback, sample_info);
+
+ caml_memprof_suspended = 0;
+
+ CAMLreturn(res);
+}
+
+/**** Capturing the call stack *****/
+
+/* This function is called for postponed blocks, so it guarantees
+ that the GC is not called. */
+static value capture_callstack_postponed(void)
+{
+ value res;
+ uintnat wosize = caml_current_callstack_size(callstack_size);
+ /* We do not use [caml_alloc] to make sure the GC will not get called. */
+ if (wosize == 0) return Atom (0);
+ res = caml_alloc_shr_no_track_noexc(wosize, 0);
+ if (res != 0) caml_current_callstack_write(res);
+ return res;
+}
+
+static value capture_callstack(void)
+{
+ value res;
+ uintnat wosize = caml_current_callstack_size(callstack_size);
+ CAMLassert(!caml_memprof_suspended);
+ caml_memprof_suspended = 1; /* => no samples in the call stack. */
+ res = caml_alloc(wosize, 0);
+ caml_memprof_suspended = 0;
+ caml_current_callstack_write(res);
+ return res;
+}
+
+/**** Handling postponed sampled blocks. ****/
+/* When allocating in from C code, we cannot call the callback,
+ because the [caml_alloc_***] are guaranteed not to do so. These
+ functions make it possible to register a sampled block in a
+ todo-list so that the callback call is performed when possible. */
+/* Note: the shorter the delay is, the better, because the block is
+ linked to a root during the delay, so that the reachability
+ properties of the sampled block are artificially modified. */
+
+#define POSTPONED_DEFAULT_QUEUE_SIZE 128
+static struct postponed_block {
+ value block;
+ value callstack;
+ uintnat occurrences;
+ enum ml_alloc_kind kind;
+} default_postponed_queue[POSTPONED_DEFAULT_QUEUE_SIZE],
+ *postponed_queue = default_postponed_queue,
+ *postponed_queue_end = default_postponed_queue + POSTPONED_DEFAULT_QUEUE_SIZE,
+ *postponed_tl = default_postponed_queue, /* Pointer to next pop */
+ *postponed_hd = default_postponed_queue; /* Pointer to next push */
+
+static struct postponed_block* postponed_next(struct postponed_block* p)
+{
+ p++;
+ if (p == postponed_queue_end) return postponed_queue;
+ else return p;
+}
+
+static void purge_postponed_queue(void)
+{
+ if (postponed_queue != default_postponed_queue) {
+ caml_stat_free(postponed_queue);
+ postponed_queue = default_postponed_queue;
+ postponed_queue_end = postponed_queue + POSTPONED_DEFAULT_QUEUE_SIZE;
+ }
+ postponed_hd = postponed_tl = postponed_queue;
+}
+
+/* This function does not call the GC. This is important since it is
+ called when allocating a block using [caml_alloc_shr]: The new
+ block is allocated, but not yet initialized, so that the heap
+ invariants are broken. */
+static void register_postponed_callback(value block, uintnat occurrences,
+ enum ml_alloc_kind kind,
+ value* callstack)
+{
+ struct postponed_block* new_hd;
+ if (occurrences == 0) return;
+ if (*callstack == 0) *callstack = capture_callstack_postponed();
+ if (*callstack == 0) return; /* OOM */
+
+ new_hd = postponed_next(postponed_hd);
+ if (new_hd == postponed_tl) {
+ /* Queue is full, reallocate it. (We always leave one free slot in
+ order to be able to distinguish the 100% full and the empty
+ states). */
+ uintnat sz = 2 * (postponed_queue_end - postponed_queue);
+ struct postponed_block* new_queue =
+ caml_stat_alloc_noexc(sz * sizeof(struct postponed_block));
+ if (new_queue == NULL) return;
+ new_hd = new_queue;
+ while (postponed_tl != postponed_hd) {
+ *new_hd = *postponed_tl;
+ new_hd++;
+ postponed_tl = postponed_next(postponed_tl);
+ }
+ if (postponed_queue != default_postponed_queue)
+ caml_stat_free(postponed_queue);
+ postponed_tl = postponed_queue = new_queue;
+ postponed_hd = new_hd;
+ postponed_queue_end = postponed_queue + sz;
+ new_hd++;
+ }
+
+ postponed_hd->block = block;
+ postponed_hd->callstack = *callstack;
+ postponed_hd->occurrences = occurrences;
+ postponed_hd->kind = kind;
+ postponed_hd = new_hd;
+
+ if (!caml_memprof_suspended) caml_set_action_pending();
+}
+
+value caml_memprof_handle_postponed_exn(void)
+{
+ CAMLparam0();
+ CAMLlocal1(block);
+ value ephe;
+
+ if (caml_memprof_suspended)
+ CAMLreturn(Val_unit);
+
+ while (postponed_tl != postponed_hd) {
+ struct postponed_block pb = *postponed_tl;
+ block = pb.block; /* pb.block is not a root! */
+ postponed_tl = postponed_next(postponed_tl);
+ if (postponed_tl == postponed_hd) purge_postponed_queue();
+
+ /* If using threads, this call can trigger reentrant calls to
+ [caml_memprof_handle_postponed] even though we set
+ [caml_memprof_suspended]. */
+ ephe = do_callback_exn(Tag_val(block), Wosize_val(block),
+ pb.occurrences, pb.callstack, pb.kind);
+
+ if (Is_exception_result(ephe)) CAMLreturn(ephe);
+
+ if (Is_block(ephe)) caml_ephemeron_set_key(Field(ephe, 0), 0, block);
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/* We don't expect these roots to live long. No need to have a special
+ case for young roots. */
+void caml_memprof_scan_roots(scanning_action f) {
+ struct postponed_block* p;
+ for(p = postponed_tl; p != postponed_hd; p = postponed_next(p)) {
+ f(p->block, &p->block);
+ f(p->callstack, &p->callstack);
+ }
+}
+
+/**** Sampling procedures ****/
+
+void caml_memprof_track_alloc_shr(value block)
+{
+ value callstack = 0;
+ CAMLassert(Is_in_heap(block));
+ /* This test also makes sure memprof is initialized. */
+ if (lambda == 0 || caml_memprof_suspended) return;
+ register_postponed_callback(
+ block, mt_generate_binom(Whsize_val(block)), Major, &callstack);
+}
+
+/* Shifts the next sample in the minor heap by [n] words. Essentially,
+ this tells the sampler to ignore the next [n] words of the minor
+ heap. */
+static void shift_sample(uintnat n)
+{
+ if (caml_memprof_young_trigger - Caml_state->young_alloc_start > n)
+ caml_memprof_young_trigger -= n;
+ else
+ caml_memprof_young_trigger = Caml_state->young_alloc_start;
+ caml_update_young_limit();
+}
+
+/* Renew the next sample in the minor heap. This needs to be called
+ after each minor sampling and after each minor collection. In
+ practice, this is called at each sampling in the minor heap and at
+ each minor collection. Extra calls do not change the statistical
+ properties of the sampling because of the memorylessness of the
+ geometric distribution. */
+void caml_memprof_renew_minor_sample(void)
+{
+
+ if (lambda == 0) /* No trigger in the current minor heap. */
+ caml_memprof_young_trigger = Caml_state->young_alloc_start;
+ else {
+ uintnat geom = mt_generate_geom();
+ if(Caml_state->young_ptr - Caml_state->young_alloc_start < geom)
+ /* No trigger in the current minor heap. */
+ caml_memprof_young_trigger = Caml_state->young_alloc_start;
+ caml_memprof_young_trigger = Caml_state->young_ptr - (geom - 1);
+ }
+
+ caml_update_young_limit();
+}
+
+/* Called when exceeding the threshold for the next sample in the
+ minor heap, from the C code (the handling is different when called
+ from natively compiled OCaml code). */
+void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml)
+{
+ CAMLparam0();
+ CAMLlocal2(ephe, callstack);
+ uintnat whsize = Whsize_wosize(wosize);
+ uintnat occurrences;
+
+ if (caml_memprof_suspended) {
+ caml_memprof_renew_minor_sample();
+ CAMLreturn0;
+ }
+
+ /* If [lambda == 0], then [caml_memprof_young_trigger] should be
+ equal to [Caml_state->young_alloc_start]. But this function is only
+ called with [Caml_state->young_alloc_start <= Caml_state->young_ptr <
+ caml_memprof_young_trigger], which is contradictory. */
+ CAMLassert(lambda > 0);
+
+ occurrences =
+ mt_generate_binom(caml_memprof_young_trigger - 1
+ - Caml_state->young_ptr) + 1;
+
+ if (!from_caml) {
+ value callstack = 0;
+ register_postponed_callback(Val_hp(Caml_state->young_ptr), occurrences,
+ Minor, &callstack);
+ caml_memprof_renew_minor_sample();
+ CAMLreturn0;
+ }
+
+ /* We need to call the callback for this sampled block. Since the
+ callback can potentially allocate, the sampled block will *not*
+ be the one pointed to by [caml_memprof_young_trigger]. Instead,
+ we remember that we need to sample the next allocated word,
+ call the callback and use as a sample the block which will be
+ allocated right after the callback. */
+
+ /* Restore the minor heap in a valid state for calling the callback.
+ We should not call the GC before these two instructions. */
+ Caml_state->young_ptr += whsize;
+ caml_memprof_renew_minor_sample();
+
+ /* Empty the queue to make sure callbacks are called in the right
+ order. */
+ caml_raise_if_exception(caml_memprof_handle_postponed_exn());
+
+ callstack = capture_callstack();
+ ephe = caml_raise_if_exception(do_callback_exn(tag, wosize, occurrences,
+ callstack, Minor));
+
+ /* We can now restore the minor heap in the state needed by
+ [Alloc_small_aux]. */
+ if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) {
+ CAML_INSTR_INT ("force_minor/memprof@", 1);
+ caml_gc_dispatch();
+ }
+
+ /* Re-allocate the block in the minor heap. We should not call the
+ GC after this. */
+ Caml_state->young_ptr -= whsize;
+
+ /* Make sure this block is not going to be sampled again. */
+ shift_sample(whsize);
+
+ /* Write the ephemeron if not [None]. */
+ if (Is_block(ephe)) {
+ /* Subtlety: we are actually writing the ephemeron with an invalid
+ (uninitialized) block. This is correct for two reasons:
+ - The logic of [caml_ephemeron_set_key] never inspects the content of
+ the block. In only checks that the block is young.
+ - The allocation and initialization happens right after returning
+ from [caml_memprof_track_young]. */
+ caml_ephemeron_set_key(Field(ephe, 0), 0, Val_hp(Caml_state->young_ptr));
+ }
+
+ /* /!\ Since the heap is in an invalid state before initialization,
+ very little heap operations are allowed until then. */
+
+ CAMLreturn0;
+}
+
+void caml_memprof_track_interned(header_t* block, header_t* blockend) {
+ header_t *p;
+ value callstack = 0;
+
+ if(lambda == 0 || caml_memprof_suspended)
+ return;
+
+ /* We have to select the sampled blocks before sampling them,
+ because sampling may trigger GC, and then blocks can escape from
+ [block, blockend[. So we use the postponing machinery for
+ selecting blocks. [intern.c] will call [check_urgent_gc] which
+ will call [caml_memprof_handle_postponed] in turn. */
+ p = block;
+ while(1) {
+ uintnat next_sample = mt_generate_geom();
+ header_t *next_sample_p, *next_p;
+ if(next_sample > blockend - p)
+ break;
+ /* [next_sample_p] is the block *following* the next sampled
+ block! */
+ next_sample_p = p + next_sample;
+
+ while(1) {
+ next_p = p + Whsize_hp(p);
+ if(next_p >= next_sample_p) break;
+ p = next_p;
+ }
+
+ register_postponed_callback(
+ Val_hp(p), mt_generate_binom(next_p - next_sample_p) + 1,
+ Unmarshalled, &callstack);
+
+ p = next_p;
+ }
+}
#include <string.h>
#include "caml/alloc.h"
+#include "caml/backtrace_prim.h"
#include "caml/config.h"
+#include "caml/debugger.h"
#include "caml/fail.h"
#include "caml/fix_code.h"
#include "caml/interp.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/prims.h"
+#include "caml/signals.h"
#include "caml/stacks.h"
-#include "caml/backtrace_prim.h"
#ifndef NATIVE_CODE
caml_thread_code((code_t) prog, len);
#endif
caml_prepare_bytecode((code_t) prog, len);
+
+ /* Notify debugger after fragment gets added and reified. */
+ caml_debugger(CODE_LOADED, Val_long(caml_code_fragments_table.size - 1));
+
clos = caml_alloc_small (1, Closure_tag);
Code_val(clos) = (code_t) prog;
bytecode = caml_alloc_small (2, Abstract_tag);
{
code_t prog;
asize_t len;
- struct code_fragment * cf = NULL, * cfi;
- int i;
+ int found, index;
+ struct code_fragment *cf;
+
prog = Bytecode_val(bc)->prog;
len = Bytecode_val(bc)->len;
caml_remove_debug_info(prog);
- for (i = 0; i < caml_code_fragments_table.size; i++) {
- cfi = (struct code_fragment *) caml_code_fragments_table.contents[i];
- if (cfi->code_start == (char *) prog &&
- cfi->code_end == (char *) prog + len) {
- cf = cfi;
- break;
- }
- }
- if (!cf) {
- /* [cf] Not matched with a caml_reify_bytecode call; impossible. */
- CAMLassert (0);
- } else {
- caml_ext_table_remove(&caml_code_fragments_table, cf);
- }
+ found = caml_find_code_fragment((char*) prog, &index, &cf);
+ /* Not matched with a caml_reify_bytecode call; impossible. */
+ CAMLassert(found); (void) found; /* Silence unused variable warning. */
+
+ /* Notify debugger before the fragment gets destroyed. */
+ caml_debugger(CODE_UNLOADED, Val_long(index));
+
+ caml_ext_table_remove(&caml_code_fragments_table, cf);
#ifndef NATIVE_CODE
caml_release_bytecode(prog, len);
return Val_unit;
}
-CAMLprim value caml_register_code_fragment(value prog, value len, value digest)
-{
- struct code_fragment * cf = caml_stat_alloc(sizeof(struct code_fragment));
- cf->code_start = (char *) prog;
- cf->code_end = (char *) prog + Long_val(len);
- memcpy(cf->digest, String_val(digest), 16);
- cf->digest_computed = 1;
- caml_ext_table_add(&caml_code_fragments_table, cf);
- return Val_unit;
-}
-
CAMLprim value caml_realloc_global(value size)
{
mlsize_t requested_size, actual_size, i;
for (i = actual_size; i < requested_size; i++){
Field (new_global_data, i) = Val_long (0);
}
+ // Give gc a chance to run, and run memprof callbacks
caml_global_data = new_global_data;
+ caml_process_pending_actions();
}
return Val_unit;
}
CAMLprim value caml_get_current_environment(value unit)
{
- return *caml_extern_sp;
+ return *Caml_state->extern_sp;
}
CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg)
arg1 to call_original_code (codeptr)
arg3 to call_original_code (arg)
arg2 to call_original_code (env)
+ saved pc
saved env */
/* Stack layout on exit:
extra_args = 0
environment = env
PC = codeptr
- arg3 to call_original_code (arg) same 6 bottom words as
+ arg3 to call_original_code (arg) same 7 bottom words as
arg2 to call_original_code (env) on entrance, but
arg1 to call_original_code (codeptr) shifted down 4 words
arg3 to call_original_code (arg)
arg2 to call_original_code (env)
+ saved pc
saved env */
value * osp, * nsp;
int i;
- osp = caml_extern_sp;
- caml_extern_sp -= 4;
- nsp = caml_extern_sp;
- for (i = 0; i < 6; i++) nsp[i] = osp[i];
- nsp[6] = codeptr;
- nsp[7] = env;
- nsp[8] = Val_int(0);
- nsp[9] = arg;
+ osp = Caml_state->extern_sp;
+ Caml_state->extern_sp -= 4;
+ nsp = Caml_state->extern_sp;
+ for (i = 0; i < 7; i++) nsp[i] = osp[i];
+ nsp[7] = codeptr;
+ nsp[8] = env;
+ nsp[9] = Val_int(0);
+ nsp[10] = arg;
return Val_unit;
}
return Val_unit; /* not reached */
}
-value * caml_stack_low;
-value * caml_stack_high;
-value * caml_stack_threshold;
-value * caml_extern_sp;
-value * caml_trapsp;
-int caml_callback_depth;
-int volatile caml_something_to_do;
-void (* volatile caml_async_action_hook)(void);
-struct longjmp_buffer * caml_external_raise;
-
#endif
#include "caml/roots.h"
#include "caml/signals.h"
#include "caml/weak.h"
+#include "caml/memprof.h"
/* Pointers into the minor heap.
- [caml_young_base]
+ [Caml_state->young_base]
The [malloc] block that contains the heap.
- [caml_young_start] ... [caml_young_end]
+ [Caml_state->young_start] ... [Caml_state->young_end]
The whole range of the minor heap: all young blocks are inside
this interval.
- [caml_young_alloc_start]...[caml_young_alloc_end]
+ [Caml_state->young_alloc_start]...[Caml_state->young_alloc_end]
The allocation arena: newly-allocated blocks are carved from
- this interval, starting at [caml_young_alloc_end].
- [caml_young_alloc_mid] is the mid-point of this interval.
- [caml_young_ptr], [caml_young_trigger], [caml_young_limit]
+ this interval, starting at [Caml_state->young_alloc_end].
+ [Caml_state->young_alloc_mid] is the mid-point of this interval.
+ [Caml_state->young_ptr], [Caml_state->young_trigger],
+ [Caml_state->young_limit]
These pointers are all inside the allocation arena.
- - [caml_young_ptr] is where the next allocation will take place.
- - [caml_young_trigger] is how far we can allocate before triggering
- [caml_gc_dispatch]. Currently, it is either [caml_young_alloc_start]
- or the mid-point of the allocation arena.
- - [caml_young_limit] is the pointer that is compared to
- [caml_young_ptr] for allocation. It is either
- [caml_young_alloc_end] if a signal is pending and we are in
- native code, or [caml_young_trigger].
+ - [Caml_state->young_ptr] is where the next allocation will take place.
+ - [Caml_state->young_trigger] is how far we can allocate before
+ triggering [caml_gc_dispatch]. Currently, it is either
+ [Caml_state->young_alloc_start] or the mid-point of the allocation
+ arena.
+ - [Caml_state->young_limit] is the pointer that is compared to
+ [Caml_state->young_ptr] for allocation. It is either:
+ + [Caml_state->young_alloc_end] if a signal handler or
+ finaliser or memprof callback is pending, or if a major
+ or minor collection has been requested, or an
+ asynchronous callback has just raised an exception,
+ + [caml_memprof_young_trigger] if a memprof sample is planned,
+ + or [Caml_state->young_trigger].
*/
struct generic_table CAML_TABLE_STRUCT(char);
-asize_t caml_minor_heap_wsz;
-static void *caml_young_base = NULL;
-CAMLexport value *caml_young_start = NULL, *caml_young_end = NULL;
-CAMLexport value *caml_young_alloc_start = NULL,
- *caml_young_alloc_mid = NULL,
- *caml_young_alloc_end = NULL;
-CAMLexport value *caml_young_ptr = NULL, *caml_young_limit = NULL;
-CAMLexport value *caml_young_trigger = NULL;
-
-CAMLexport struct caml_ref_table
- caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
-
-CAMLexport struct caml_ephe_ref_table
- caml_ephe_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
-
-CAMLexport struct caml_custom_table
- caml_custom_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
-/* Table of custom blocks in the minor heap that contain finalizers
- or GC speed parameters. */
-
-int caml_in_minor_collection = 0;
-
-double caml_extra_heap_resources_minor = 0;
+void caml_alloc_minor_tables ()
+{
+ Caml_state->ref_table =
+ caml_stat_alloc_noexc(sizeof(struct caml_ref_table));
+ if (Caml_state->ref_table == NULL)
+ caml_fatal_error ("cannot initialize minor heap");
+ memset(Caml_state->ref_table, 0, sizeof(struct caml_ref_table));
+
+ Caml_state->ephe_ref_table =
+ caml_stat_alloc_noexc(sizeof(struct caml_ephe_ref_table));
+ if (Caml_state->ephe_ref_table == NULL)
+ caml_fatal_error ("cannot initialize minor heap");
+ memset(Caml_state->ephe_ref_table, 0, sizeof(struct caml_ephe_ref_table));
+
+ Caml_state->custom_table =
+ caml_stat_alloc_noexc(sizeof(struct caml_custom_table));
+ if (Caml_state->custom_table == NULL)
+ caml_fatal_error ("cannot initialize minor heap");
+ memset(Caml_state->custom_table, 0, sizeof(struct caml_custom_table));
+}
/* [sz] and [rsv] are numbers of entries */
static void alloc_generic_table (struct generic_table *tbl, asize_t sz,
CAMLassert (bsz <= Bsize_wsize(Minor_heap_max));
CAMLassert (bsz % Page_size == 0);
CAMLassert (bsz % sizeof (value) == 0);
- if (caml_young_ptr != caml_young_alloc_end){
+ if (Caml_state->young_ptr != Caml_state->young_alloc_end){
CAML_INSTR_INT ("force_minor/set_minor_heap_size@", 1);
- caml_requested_minor_gc = 0;
- caml_young_trigger = caml_young_alloc_mid;
- caml_young_limit = caml_young_trigger;
+ Caml_state->requested_minor_gc = 0;
+ Caml_state->young_trigger = Caml_state->young_alloc_mid;
+ caml_update_young_limit();
caml_empty_minor_heap ();
}
- CAMLassert (caml_young_ptr == caml_young_alloc_end);
+ CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end);
new_heap = caml_stat_alloc_aligned_noexc(bsz, 0, &new_heap_base);
if (new_heap == NULL) caml_raise_out_of_memory();
if (caml_page_table_add(In_young, new_heap, new_heap + bsz) != 0)
caml_raise_out_of_memory();
- if (caml_young_start != NULL){
- caml_page_table_remove(In_young, caml_young_start, caml_young_end);
- caml_stat_free (caml_young_base);
+ if (Caml_state->young_start != NULL){
+ caml_page_table_remove(In_young, Caml_state->young_start,
+ Caml_state->young_end);
+ caml_stat_free (Caml_state->young_base);
}
- caml_young_base = new_heap_base;
- caml_young_start = (value *) new_heap;
- caml_young_end = (value *) (new_heap + bsz);
- caml_young_alloc_start = caml_young_start;
- caml_young_alloc_mid = caml_young_alloc_start + Wsize_bsize (bsz) / 2;
- caml_young_alloc_end = caml_young_end;
- caml_young_trigger = caml_young_alloc_start;
- caml_young_limit = caml_young_trigger;
- caml_young_ptr = caml_young_alloc_end;
- caml_minor_heap_wsz = Wsize_bsize (bsz);
-
- reset_table ((struct generic_table *) &caml_ref_table);
- reset_table ((struct generic_table *) &caml_ephe_ref_table);
- reset_table ((struct generic_table *) &caml_custom_table);
+ Caml_state->young_base = new_heap_base;
+ Caml_state->young_start = (value *) new_heap;
+ Caml_state->young_end = (value *) (new_heap + bsz);
+ Caml_state->young_alloc_start = Caml_state->young_start;
+ Caml_state->young_alloc_mid =
+ Caml_state->young_alloc_start + Wsize_bsize (bsz) / 2;
+ Caml_state->young_alloc_end = Caml_state->young_end;
+ Caml_state->young_trigger = Caml_state->young_alloc_start;
+ caml_update_young_limit();
+ Caml_state->young_ptr = Caml_state->young_alloc_end;
+ Caml_state->minor_heap_wsz = Wsize_bsize (bsz);
+ caml_memprof_renew_minor_sample();
+
+ reset_table ((struct generic_table *) Caml_state->ref_table);
+ reset_table ((struct generic_table *) Caml_state->ephe_ref_table);
+ reset_table ((struct generic_table *) Caml_state->custom_table);
}
static value oldify_todo_list = 0;
tail_call:
if (Is_block (v) && Is_young (v)){
- CAMLassert ((value *) Hp_val (v) >= caml_young_ptr);
+ CAMLassert ((value *) Hp_val (v) >= Caml_state->young_ptr);
hd = Hd_val (v);
if (hd == 0){ /* If already forwarded */
*p = Field (v, 0); /* then forward pointer is first field. */
value field0;
sz = Wosize_hd (hd);
- result = caml_alloc_shr_preserving_profinfo (sz, tag, hd);
+ result = caml_alloc_shr_for_minor_gc (sz, tag, hd);
*p = result;
field0 = Field (v, 0);
Hd_val (v) = 0; /* Set forward flag */
}
}else if (tag >= No_scan_tag){
sz = Wosize_hd (hd);
- result = caml_alloc_shr_preserving_profinfo (sz, tag, hd);
+ result = caml_alloc_shr_for_minor_gc (sz, tag, hd);
for (i = 0; i < sz; i++) Field (result, i) = Field (v, i);
Hd_val (v) = 0; /* Set forward flag */
Field (v, 0) = result; /* and forward pointer. */
){
/* Do not short-circuit the pointer. Copy as a normal block. */
CAMLassert (Wosize_hd (hd) == 1);
- result = caml_alloc_shr_preserving_profinfo (1, Forward_tag, hd);
+ result = caml_alloc_shr_for_minor_gc (1, Forward_tag, hd);
*p = result;
Hd_val (v) = 0; /* Set (GC) forward flag */
Field (v, 0) = result; /* and forward pointer. */
/* Oldify the data in the minor heap of alive ephemeron
During minor collection keys outside the minor heap are considered alive */
- for (re = caml_ephe_ref_table.base;
- re < caml_ephe_ref_table.ptr; re++){
+ for (re = Caml_state->ephe_ref_table->base;
+ re < Caml_state->ephe_ref_table->ptr; re++){
/* look only at ephemeron with data in the minor heap */
if (re->offset == 1){
value *data = &Field(re->ephe,1);
uintnat prev_alloc_words;
struct caml_ephe_ref_elt *re;
- if (caml_young_ptr != caml_young_alloc_end){
+ if (Caml_state->young_ptr != Caml_state->young_alloc_end){
if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) ();
CAML_INSTR_SETUP (tmr, "minor");
prev_alloc_words = caml_allocated_words;
- caml_in_minor_collection = 1;
+ Caml_state->in_minor_collection = 1;
caml_gc_message (0x02, "<");
caml_oldify_local_roots();
CAML_INSTR_TIME (tmr, "minor/local_roots");
- for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++){
+ for (r = Caml_state->ref_table->base;
+ r < Caml_state->ref_table->ptr; r++) {
caml_oldify_one (**r, *r);
}
CAML_INSTR_TIME (tmr, "minor/ref_table");
caml_oldify_mopup ();
CAML_INSTR_TIME (tmr, "minor/copy");
/* Update the ephemerons */
- for (re = caml_ephe_ref_table.base;
- re < caml_ephe_ref_table.ptr; re++){
+ for (re = Caml_state->ephe_ref_table->base;
+ re < Caml_state->ephe_ref_table->ptr; re++){
if(re->offset < Wosize_val(re->ephe)){
/* If it is not the case, the ephemeron has been truncated */
value *key = &Field(re->ephe,re->offset);
/* Update the OCaml finalise_last values */
caml_final_update_minor_roots();
/* Run custom block finalisation of dead minor values */
- for (elt = caml_custom_table.base; elt < caml_custom_table.ptr; elt++){
+ for (elt = Caml_state->custom_table->base;
+ elt < Caml_state->custom_table->ptr; elt++){
value v = elt->block;
if (Hd_val (v) == 0){
/* Block was copied to the major heap: adjust GC speed numbers. */
}
}
CAML_INSTR_TIME (tmr, "minor/update_weak");
- caml_stat_minor_words += caml_young_alloc_end - caml_young_ptr;
- caml_gc_clock += (double) (caml_young_alloc_end - caml_young_ptr)
- / caml_minor_heap_wsz;
- caml_young_ptr = caml_young_alloc_end;
- clear_table ((struct generic_table *) &caml_ref_table);
- clear_table ((struct generic_table *) &caml_ephe_ref_table);
- clear_table ((struct generic_table *) &caml_custom_table);
- caml_extra_heap_resources_minor = 0;
+ Caml_state->stat_minor_words +=
+ Caml_state->young_alloc_end - Caml_state->young_ptr;
+ caml_gc_clock +=
+ (double) (Caml_state->young_alloc_end - Caml_state->young_ptr)
+ / Caml_state->minor_heap_wsz;
+ Caml_state->young_ptr = Caml_state->young_alloc_end;
+ clear_table ((struct generic_table *) Caml_state->ref_table);
+ clear_table ((struct generic_table *) Caml_state->ephe_ref_table);
+ clear_table ((struct generic_table *) Caml_state->custom_table);
+ Caml_state->extra_heap_resources_minor = 0;
caml_gc_message (0x02, ">");
- caml_in_minor_collection = 0;
+ Caml_state->in_minor_collection = 0;
caml_final_empty_young ();
CAML_INSTR_TIME (tmr, "minor/finalized");
- caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
+ Caml_state->stat_promoted_words += caml_allocated_words - prev_alloc_words;
CAML_INSTR_INT ("minor/promoted#", caml_allocated_words - prev_alloc_words);
- ++ caml_stat_minor_collections;
+ ++ Caml_state->stat_minor_collections;
+ caml_memprof_renew_minor_sample();
if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) ();
}else{
/* The minor heap is empty nothing to do. */
#ifdef DEBUG
{
value *p;
- for (p = caml_young_alloc_start; p < caml_young_alloc_end; ++p){
+ for (p = Caml_state->young_alloc_start; p < Caml_state->young_alloc_end;
+ ++p) {
*p = Debug_free_minor;
}
}
/* Do a minor collection or a slice of major collection, call finalisation
functions, etc.
Leave enough room in the minor heap to allocate at least one object.
+ Guaranteed not to call any OCaml callback.
*/
CAMLexport void caml_gc_dispatch (void)
{
- value *trigger = caml_young_trigger; /* save old value of trigger */
+ value *trigger = Caml_state->young_trigger; /* save old value of trigger */
#ifdef CAML_INSTR
CAML_INSTR_SETUP(tmr, "dispatch");
CAML_INSTR_TIME (tmr, "overhead");
caml_instr_alloc_jump = 0;
#endif
- if (trigger == caml_young_alloc_start || caml_requested_minor_gc){
+ if (trigger == Caml_state->young_alloc_start
+ || Caml_state->requested_minor_gc) {
/* The minor heap is full, we must do a minor collection. */
/* reset the pointers first because the end hooks might allocate */
- caml_requested_minor_gc = 0;
- caml_young_trigger = caml_young_alloc_mid;
- caml_young_limit = caml_young_trigger;
+ Caml_state->requested_minor_gc = 0;
+ Caml_state->young_trigger = Caml_state->young_alloc_mid;
+ caml_update_young_limit();
caml_empty_minor_heap ();
/* The minor heap is empty, we can start a major collection. */
if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/minor");
-
- caml_final_do_calls ();
- CAML_INSTR_TIME (tmr, "dispatch/finalizers");
-
- while (caml_young_ptr - caml_young_alloc_start < Max_young_whsize){
- /* The finalizers or the hooks have filled up the minor heap, we must
- repeat the minor collection. */
- caml_requested_minor_gc = 0;
- caml_young_trigger = caml_young_alloc_mid;
- caml_young_limit = caml_young_trigger;
- caml_empty_minor_heap ();
- /* The minor heap is empty, we can start a major collection. */
- if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1);
- CAML_INSTR_TIME (tmr, "dispatch/finalizers_minor");
- }
}
- if (trigger != caml_young_alloc_start || caml_requested_major_slice){
+ if (trigger != Caml_state->young_alloc_start
+ || Caml_state->requested_major_slice) {
/* The minor heap is half-full, do a major GC slice. */
- caml_requested_major_slice = 0;
- caml_young_trigger = caml_young_alloc_start;
- caml_young_limit = caml_young_trigger;
+ Caml_state->requested_major_slice = 0;
+ Caml_state->young_trigger = Caml_state->young_alloc_start;
+ caml_update_young_limit();
caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/major");
}
}
-/* For backward compatibility with Lablgtk: do a minor collection to
- ensure that the minor heap is empty.
+/* Called by [Alloc_small] when [Caml_state->young_ptr] reaches
+ [Caml_state->young_limit]. We may have to either call memprof or
+ the gc. */
+void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags)
+{
+ intnat whsize = Whsize_wosize (wosize);
+
+ /* First, we un-do the allocation performed in [Alloc_small] */
+ Caml_state->young_ptr += whsize;
+
+ while(1) {
+ /* We might be here because of an async callback / urgent GC
+ request. Take the opportunity to do what has been requested. */
+ if (flags & CAML_FROM_CAML)
+ /* In the case of allocations performed from OCaml, execute
+ asynchronous callbacks. */
+ caml_raise_if_exception(caml_do_pending_actions_exn ());
+ else {
+ caml_check_urgent_gc (Val_unit);
+ /* In the case of long-running C code that regularly polls with
+ caml_process_pending_actions, force a query of all callbacks
+ at every minor collection or major slice. */
+ caml_something_to_do = 1;
+ }
+
+ /* Now, there might be enough room in the minor heap to do our
+ allocation. */
+ if (Caml_state->young_ptr - whsize >= Caml_state->young_trigger)
+ break;
+
+ /* If not, then empty the minor heap, and check again for async
+ callbacks. */
+ CAML_INSTR_INT ("force_minor/alloc_small@", 1);
+ caml_gc_dispatch ();
+ }
+
+ /* Re-do the allocation: we now have enough space in the minor heap. */
+ Caml_state->young_ptr -= whsize;
+
+ /* Check if the allocated block has been sampled by memprof. */
+ if(Caml_state->young_ptr < caml_memprof_young_trigger){
+ if(flags & CAML_DO_TRACK) {
+ caml_memprof_track_young(tag, wosize, flags & CAML_FROM_CAML);
+ /* Until the allocation actually takes place, the heap is in an invalid
+ state (see comments in [caml_memprof_track_young]). Hence, very little
+ heap operations are allowed before the actual allocation.
+
+ Moreover, [Caml_state->young_ptr] should not be modified before the
+ allocation, because its value has been used as the pointer to
+ the sampled block.
+ */
+ } else caml_memprof_renew_minor_sample();
+ }
+}
+
+/* Exported for backward compatibility with Lablgtk: do a minor
+ collection to ensure that the minor heap is empty.
*/
CAMLexport void caml_minor_collection (void)
{
- caml_requested_minor_gc = 1;
+ Caml_state->requested_minor_gc = 1;
caml_gc_dispatch ();
}
CAMLexport value caml_check_urgent_gc (value extra_root)
{
- CAMLparam1 (extra_root);
- if (caml_requested_major_slice || caml_requested_minor_gc){
+ if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc){
+ CAMLparam1 (extra_root);
CAML_INSTR_INT ("force_minor/check_urgent_gc@", 1);
caml_gc_dispatch();
+ CAMLdrop;
}
- CAMLreturn (extra_root);
+ return extra_root;
}
static void realloc_generic_table
CAMLassert (tbl->limit >= tbl->threshold);
if (tbl->base == NULL){
- alloc_generic_table (tbl, caml_minor_heap_wsz / 8, 256,
+ alloc_generic_table (tbl, Caml_state->minor_heap_wsz / 8, 256,
element_size);
}else if (tbl->limit == tbl->threshold){
CAML_INSTR_INT (msg_intr_int, 1);
}else{
asize_t sz;
asize_t cur_ptr = tbl->ptr - tbl->base;
- CAMLassert (caml_requested_minor_gc);
+ CAMLassert (Caml_state->requested_minor_gc);
tbl->size *= 2;
sz = (tbl->size + tbl->reserve) * element_size;
}
}
+void (*caml_fatal_error_hook) (char *msg, va_list args) = NULL;
+
CAMLexport void caml_fatal_error (char *msg, ...)
{
va_list ap;
va_start(ap, msg);
- fprintf (stderr, "Fatal error: ");
- vfprintf (stderr, msg, ap);
+ if(caml_fatal_error_hook != NULL) {
+ caml_fatal_error_hook(msg, ap);
+ } else {
+ fprintf (stderr, "Fatal error: ");
+ vfprintf (stderr, msg, ap);
+ fprintf (stderr, "\n");
+ }
va_end(ap);
- fprintf (stderr, "\n");
- exit(2);
+ abort();
}
/* If you change the caml_ext_table* functions, also update
char *name = fname;
if (name[0] == '@'){
- snprintf (buf, sizeof(buf), "%s.%d", name + 1, getpid ());
+ snprintf (buf, sizeof(buf), "%s.%lld",
+ name + 1, (long long) (getpid ()));
name = buf;
}
if (name[0] == '+'){
}
}
#endif /* CAML_INSTR */
+
+int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf)
+{
+ struct code_fragment *cfi;
+ int i;
+
+ for (i = 0; i < caml_code_fragments_table.size; i++) {
+ cfi = (struct code_fragment *) caml_code_fragments_table.contents[i];
+ if ((char*) pc >= cfi->code_start && (char*) pc < cfi->code_end) {
+ if (index != NULL) *index = i;
+ if (cf != NULL) *cf = cfi;
+ return 1;
+ }
+ }
+ return 0;
+}
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/prims.h"
+#include "caml/signals.h"
#include "caml/spacetime.h"
/* [size] is a value encoding a number of bytes */
} else {
res = caml_alloc_shr(sz, tg);
for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
+ // Give gc a chance to run, and run memprof callbacks
+ caml_process_pending_actions();
}
CAMLreturn (res);
}
.abiversion 2
#endif
+/* Special registers */
+#define START_PRG_ARG 12
+#define START_PRG_DOMAIN_STATE_PTR 7
+#define C_CALL_FUN 25
+#define C_CALL_TOC 26
+#define C_CALL_RET_ADDR 27
+#define DOMAIN_STATE_PTR 28
+#define TRAP_PTR 29
+#define ALLOC_LIMIT 30
+#define ALLOC_PTR 31
+
#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
#define EITHER(a,b) b
#else
#define Addrglobal(reg,glob) \
addis reg, 0, glob@ha; \
addi reg, reg, glob@l
-#define Loadglobal(reg,glob,tmp) \
- addis tmp, 0, glob@ha; \
- lg reg, glob@l(tmp)
-#define Storeglobal(reg,glob,tmp) \
- addis tmp, 0, glob@ha; \
- stg reg, glob@l(tmp)
-#define Loadglobal32(reg,glob,tmp) \
- addis tmp, 0, glob@ha; \
- lwz reg, glob@l(tmp)
-#define Storeglobal32(reg,glob,tmp) \
- addis tmp, 0, glob@ha; \
- stw reg, glob@l(tmp)
-
#endif
#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
#define Addrglobal(reg,glob) \
ld reg, LSYMB(glob)@toc(2)
-#define Loadglobal(reg,glob,tmp) \
- Addrglobal(tmp,glob); \
- lg reg, 0(tmp)
-#define Storeglobal(reg,glob,tmp) \
- Addrglobal(tmp,glob); \
- stg reg, 0(tmp)
-#define Loadglobal32(reg,glob,tmp) \
- Addrglobal(tmp,glob); \
- lwz reg, 0(tmp)
-#define Storeglobal32(reg,glob,tmp) \
- Addrglobal(tmp,glob); \
- stw reg, 0(tmp)
-
#endif
+ .set domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+ .equ domain_field_caml_##name, domain_curr_field ; \
+ .set domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) 8*domain_field_caml_##var(28)
+
#if defined(MODEL_ppc64)
.section ".opd","aw"
#else
stwu 1, -STACKSIZE(1)
/* Record return address into OCaml code */
mflr 0
- Storeglobal(0, caml_last_return_address, 11)
+ stg 0, Caml_state(last_return_address)
/* Record lowest stack address */
addi 0, 1, STACKSIZE
- Storeglobal(0, caml_bottom_of_stack, 11)
+ stg 0, Caml_state(bottom_of_stack)
/* Record pointer to register array */
addi 0, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK
- Storeglobal(0, caml_gc_regs, 11)
+ stg 0, Caml_state(gc_regs)
/* Save current allocation pointer for debugging purposes */
- Storeglobal(31, caml_young_ptr, 11)
+ stg ALLOC_PTR, Caml_state(young_ptr)
/* Save exception pointer (if e.g. a sighandler raises) */
- Storeglobal(29, caml_exception_pointer, 11)
+ stg TRAP_PTR, Caml_state(exception_pointer)
/* Save all registers used by the code generator */
addi 11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD
stgu 3, WORD(11)
nop
#endif
/* Reload new allocation pointer and allocation limit */
- Loadglobal(31, caml_young_ptr, 11)
- Loadglobal(30, caml_young_limit, 11)
+ lg ALLOC_PTR, Caml_state(young_ptr)
+ lg ALLOC_LIMIT, Caml_state(young_limit)
/* Restore all regs used by the code generator */
addi 11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD
lgu 3, WORD(11)
lfdu 30, 8(11)
lfdu 31, 8(11)
/* Return to caller, restarting the allocation */
- Loadglobal(11, caml_last_return_address, 11)
+ lg 11, Caml_state(last_return_address)
addi 11, 11, -16 /* Restart the allocation (4 instructions) */
mtlr 11
/* For PPC64: restore the TOC that the caller saved at the usual place */
FUNCTION(caml_c_call)
.cfi_startproc
/* Save return address in a callee-save register */
- mflr 27
- .cfi_register 65, 27
+ mflr C_CALL_RET_ADDR
+ .cfi_register 65, C_CALL_RET_ADDR
/* Record lowest stack address and return address */
- Storeglobal(1, caml_bottom_of_stack, 11)
- Storeglobal(27, caml_last_return_address, 11)
+ stg 1, Caml_state(bottom_of_stack)
+ stg C_CALL_RET_ADDR, Caml_state(last_return_address)
/* Make the exception handler and alloc ptr available to the C code */
- Storeglobal(31, caml_young_ptr, 11)
- Storeglobal(29, caml_exception_pointer, 11)
- /* Call C function (address in r28) */
+ stg ALLOC_PTR, Caml_state(young_ptr)
+ stg TRAP_PTR, Caml_state(exception_pointer)
+ /* Call C function (address in C_CALL_FUN) */
#if defined(MODEL_ppc)
- mtctr 28
+ mtctr C_CALL_FUN
bctrl
#elif defined(MODEL_ppc64)
- ld 0, 0(28)
- mr 26, 2 /* save current TOC in a callee-save register */
+ ld 0, 0(C_CALL_FUN)
+ mr C_CALL_TOC, 2 /* save current TOC in a callee-save register */
mtctr 0
- ld 2, 8(28)
+ ld 2, 8(C_CALL_FUN)
bctrl
- mr 2, 26 /* restore current TOC */
+ mr 2, C_CALL_TOC /* restore current TOC */
#elif defined(MODEL_ppc64le)
- mtctr 28
- mr 12, 28
- mr 26, 2 /* save current TOC in a callee-save register */
+ mtctr C_CALL_FUN
+ mr 12, C_CALL_FUN
+ mr C_CALL_TOC, 2 /* save current TOC in a callee-save register */
bctrl
- mr 2, 26 /* restore current TOC */
+ mr 2, C_CALL_TOC /* restore current TOC */
#else
#error "wrong MODEL"
#endif
/* Restore return address (in 27, preserved by the C function) */
- mtlr 27
+ mtlr C_CALL_RET_ADDR
/* Reload allocation pointer and allocation limit*/
- Loadglobal(31, caml_young_ptr, 11)
- Loadglobal(30, caml_young_limit, 11)
+ lg ALLOC_PTR, Caml_state(young_ptr)
+ lg ALLOC_LIMIT, Caml_state(young_limit)
/* Return to caller */
blr
.cfi_endproc
/* Raise an exception from OCaml */
FUNCTION(caml_raise_exn)
- Loadglobal32(0, caml_backtrace_active, 11)
+ lg 0, Caml_state(backtrace_active)
cmpwi 0, 0
bne .L111
.L110:
/* Pop trap frame */
- lg 0, TRAP_HANDLER_OFFSET(29)
- mr 1, 29
+ lg 0, TRAP_HANDLER_OFFSET(TRAP_PTR)
+ mr 1, TRAP_PTR
mtctr 0
- lg 29, TRAP_PREVIOUS_OFFSET(1)
+ lg TRAP_PTR, TRAP_PREVIOUS_OFFSET(1)
addi 1, 1, TRAP_SIZE
/* Branch to handler */
bctr
.L111:
- mr 28, 3 /* preserve exn bucket in callee-save reg */
+ mr 27, 3 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r3 */
mflr 4 /* arg2: PC of raise */
mr 5, 1 /* arg3: SP of raise */
- mr 6, 29 /* arg4: SP of handler */
+ mr 6, TRAP_PTR /* arg4: SP of handler */
addi 1, 1, -(PARAM_SAVE_AREA + RESERVED_STACK)
/* reserve stack space for C call */
bl caml_stash_backtrace
#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
nop
#endif
- mr 3, 28 /* restore exn bucket */
+ mr 3, 27 /* restore exn bucket */
b .L110 /* raise the exn */
ENDFUNCTION(caml_raise_exn)
/* Raise an exception from C */
FUNCTION(caml_raise_exception)
- Loadglobal32(0, caml_backtrace_active, 11)
+ /* Load domain state pointer */
+ mr DOMAIN_STATE_PTR, 3
+ mr 3, 4
+ lg 0, Caml_state(backtrace_active)
cmpwi 0, 0
bne .L121
.L120:
/* Reload OCaml global registers */
- Loadglobal(1, caml_exception_pointer, 11)
- Loadglobal(31, caml_young_ptr, 11)
- Loadglobal(30, caml_young_limit, 11)
+ lg 1, Caml_state(exception_pointer)
+ lg ALLOC_PTR, Caml_state(young_ptr)
+ lg ALLOC_LIMIT, Caml_state(young_limit)
/* Pop trap frame */
lg 0, TRAP_HANDLER_OFFSET(1)
mtctr 0
- lg 29, TRAP_PREVIOUS_OFFSET(1)
+ lg TRAP_PTR, TRAP_PREVIOUS_OFFSET(1)
addi 1, 1, TRAP_SIZE
/* Branch to handler */
bctr
.L121:
li 0, 0
- Storeglobal32(0, caml_backtrace_pos, 11)
- mr 28, 3 /* preserve exn bucket in callee-save reg */
+ stg 0, Caml_state(backtrace_pos)
+ mr 27, 3 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r3 */
- Loadglobal(4, caml_last_return_address, 11) /* arg2: PC of raise */
- Loadglobal(5, caml_bottom_of_stack, 11) /* arg3: SP of raise */
- Loadglobal(6, caml_exception_pointer, 11) /* arg4: SP of handler */
+ lg 4, Caml_state(last_return_address) /* arg2: PC of raise */
+ lg 5, Caml_state(bottom_of_stack) /* arg3: SP of raise */
+ lg 6, Caml_state(exception_pointer) /* arg4: SP of handler */
addi 1, 1, -(PARAM_SAVE_AREA + RESERVED_STACK)
/* reserve stack space for C call */
bl caml_stash_backtrace
#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
nop
#endif
- mr 3, 28 /* restore exn bucket */
+ mr 3, 27 /* restore exn bucket */
b .L120 /* raise the exn */
ENDFUNCTION(caml_raise_exception)
.cfi_startproc
#define STACKSIZE (WORD*18 + 8*18 + CALLBACK_LINK_SIZE + RESERVED_STACK)
/* 18 callee-save GPR14...GPR31 + 18 callee-save FPR14...FPR31 */
- Addrglobal(12, caml_program)
+ /* Domain state pointer is the first arg to caml_start_program. Move it */
+ mr START_PRG_DOMAIN_STATE_PTR, 3
+ Addrglobal(START_PRG_ARG, caml_program)
/* Code shared between caml_start_program and caml_callback */
.L102:
/* Allocate and link stack frame */
stfdu 29, 8(11)
stfdu 30, 8(11)
stfdu 31, 8(11)
+ /* Load domain state pointer from argument */
+ mr DOMAIN_STATE_PTR, START_PRG_DOMAIN_STATE_PTR
/* Set up a callback link */
- Loadglobal(11, caml_bottom_of_stack, 11)
+ lg 11, Caml_state(bottom_of_stack)
stg 11, CALLBACK_LINK_OFFSET(1)
- Loadglobal(11, caml_last_return_address, 11)
+ lg 11, Caml_state(last_return_address)
stg 11, (CALLBACK_LINK_OFFSET + WORD)(1)
- Loadglobal(11, caml_gc_regs, 11)
+ lg 11, Caml_state(gc_regs)
stg 11, (CALLBACK_LINK_OFFSET + 2 * WORD)(1)
/* Build an exception handler to catch exceptions escaping out of OCaml */
bl .L103
.cfi_adjust_cfa_offset TRAP_SIZE
mflr 0
stg 0, TRAP_HANDLER_OFFSET(1)
- Loadglobal(11, caml_exception_pointer, 11)
+ lg 11, Caml_state(exception_pointer)
stg 11, TRAP_PREVIOUS_OFFSET(1)
- mr 29, 1
+ mr TRAP_PTR, 1
/* Reload allocation pointers */
- Loadglobal(31, caml_young_ptr, 11)
- Loadglobal(30, caml_young_limit, 11)
+ lg ALLOC_PTR, Caml_state(young_ptr)
+ lg ALLOC_LIMIT, Caml_state(young_limit)
/* Call the OCaml code (address in r12) */
#if defined(MODEL_ppc)
mtctr 12
#endif
/* Pop the trap frame, restoring caml_exception_pointer */
lg 0, TRAP_PREVIOUS_OFFSET(1)
- Storeglobal(0, caml_exception_pointer, 11)
+ stg 0, Caml_state(exception_pointer)
addi 1, 1, TRAP_SIZE
.cfi_adjust_cfa_offset -TRAP_SIZE
/* Pop the callback link, restoring the global variables */
.L106:
lg 0, CALLBACK_LINK_OFFSET(1)
- Storeglobal(0, caml_bottom_of_stack, 11)
+ stg 0, Caml_state(bottom_of_stack)
lg 0, (CALLBACK_LINK_OFFSET + WORD)(1)
- Storeglobal(0, caml_last_return_address, 11)
+ stg 0, Caml_state(last_return_address)
lg 0, (CALLBACK_LINK_OFFSET + 2 * WORD)(1)
- Storeglobal(0, caml_gc_regs, 11)
+ stg 0, Caml_state(gc_regs)
/* Update allocation pointer */
- Storeglobal(31, caml_young_ptr, 11)
+ stg ALLOC_PTR, Caml_state(young_ptr)
/* Restore callee-save registers */
addi 11, 1, CALLBACK_LINK_SIZE + RESERVED_STACK - WORD
lgu 14, WORD(11)
ld 2, (STACKSIZE + TOC_SAVE_PARENT)(1)
#endif
/* Update caml_exception_pointer */
- Storeglobal(29, caml_exception_pointer, 11)
+ stg TRAP_PTR, Caml_state(exception_pointer)
/* Encode exception bucket as an exception result and return it */
ori 3, 3, 2
b .L106
/* Callback from C to OCaml */
-FUNCTION(caml_callback_exn)
+FUNCTION(caml_callback_asm)
/* Initial shuffling of arguments */
- mr 0, 3 /* Closure */
- mr 3, 4 /* Argument */
- mr 4, 0
- lg 12, 0(4) /* Code pointer */
+ /* r3 = Caml_state, r4 = closure, 0(r5) = first arg */
+ mr START_PRG_DOMAIN_STATE_PTR, 3
+ lg 3, 0(5) /* r3 = Argument */
+ /* r4 = Closure */
+ lg START_PRG_ARG, 0(4) /* Code pointer */
b .L102
-ENDFUNCTION(caml_callback_exn)
-
-FUNCTION(caml_callback2_exn)
- mr 0, 3 /* Closure */
- mr 3, 4 /* First argument */
- mr 4, 5 /* Second argument */
- mr 5, 0
- Addrglobal(12, caml_apply2)
+ENDFUNCTION(caml_callback_asm)
+
+FUNCTION(caml_callback2_asm)
+ /* r3 = Caml_state, r4 = closure, 0(r5) = first arg,
+ WORD(r5) = second arg */
+ mr START_PRG_DOMAIN_STATE_PTR, 3
+ mr 0, 4
+ lg 3, 0(5) /* r3 = First argument */
+ lg 4, WORD(5) /* r4 = Second argument */
+ mr 5, 0 /* r5 = Closure */
+ Addrglobal(START_PRG_ARG, caml_apply2)
b .L102
-ENDFUNCTION(caml_callback2_exn)
-
-FUNCTION(caml_callback3_exn)
- mr 0, 3 /* Closure */
- mr 3, 4 /* First argument */
- mr 4, 5 /* Second argument */
- mr 5, 6 /* Third argument */
- mr 6, 0
- Addrglobal(12, caml_apply3)
+ENDFUNCTION(caml_callback2_asm)
+
+FUNCTION(caml_callback3_asm)
+ /* r3 = Caml_state, r4 = closure, 0(r5) = first arg, WORD(r5) = second arg,
+ 2*WORD(r5) = third arg */
+ mr START_PRG_DOMAIN_STATE_PTR, 3
+ mr 6, 4 /* r6 = Closure */
+ lg 3, 0(5) /* r3 = First argument */
+ lg 4, WORD(5) /* r4 = Second argument */
+ lg 5, 2*WORD(5) /* r5 = Third argument */
+ Addrglobal(START_PRG_ARG, caml_apply3)
b .L102
-ENDFUNCTION(caml_callback3_exn)
+ENDFUNCTION(caml_callback3_asm)
#if defined(MODEL_ppc64)
.section ".opd","aw"
TOCENTRY(caml_apply2)
TOCENTRY(caml_apply3)
-TOCENTRY(caml_backtrace_active)
-TOCENTRY(caml_backtrace_pos)
-TOCENTRY(caml_bottom_of_stack)
-TOCENTRY(caml_exception_pointer)
-TOCENTRY(caml_gc_regs)
-TOCENTRY(caml_last_return_address)
TOCENTRY(caml_program)
-TOCENTRY(caml_young_limit)
-TOCENTRY(caml_young_ptr)
#endif
#include "caml/mlvalues.h"
#include "caml/printexc.h"
#include "caml/memory.h"
+#include "caml/memprof.h"
struct stringbuf {
char * ptr;
msg = caml_format_exception(exn);
/* Perform "at_exit" processing, ignoring all exceptions that may
be triggered by this */
- saved_backtrace_active = caml_backtrace_active;
- saved_backtrace_pos = caml_backtrace_pos;
- caml_backtrace_active = 0;
+ saved_backtrace_active = Caml_state->backtrace_active;
+ saved_backtrace_pos = Caml_state->backtrace_pos;
+ Caml_state->backtrace_active = 0;
at_exit = caml_named_value("Pervasives.do_at_exit");
if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit);
- caml_backtrace_active = saved_backtrace_active;
- caml_backtrace_pos = saved_backtrace_pos;
+ Caml_state->backtrace_active = saved_backtrace_active;
+ Caml_state->backtrace_pos = saved_backtrace_pos;
/* Display the uncaught exception */
fprintf(stderr, "Fatal error: exception %s\n", msg);
caml_stat_free(msg);
/* Display the backtrace if available */
- if (caml_backtrace_active && !DEBUGGER_IN_USE)
+ if (Caml_state->backtrace_active && !DEBUGGER_IN_USE)
caml_print_exception_backtrace();
}
handle_uncaught_exception =
caml_named_value("Printexc.handle_uncaught_exception");
+
+ /* If the callback allocates, memprof could be called. In this case,
+ memprof's callback could raise an exception while
+ [handle_uncaught_exception] is running, so that the printing of
+ the exception fails. */
+ caml_memprof_suspended = 1;
+
if (handle_uncaught_exception != NULL)
/* [Printexc.handle_uncaught_exception] does not raise exception. */
caml_callback2(*handle_uncaught_exception, exn, Val_bool(DEBUGGER_IN_USE));
#include "caml/mlvalues.h"
#include "caml/roots.h"
#include "caml/stacks.h"
-
-CAMLexport struct caml__roots_block *caml_local_roots = NULL;
+#include "caml/memprof.h"
CAMLexport void (*caml_scan_roots_hook) (scanning_action f) = NULL;
intnat i, j;
/* The stack */
- for (sp = caml_extern_sp; sp < caml_stack_high; sp++) {
+ for (sp = Caml_state->extern_sp; sp < Caml_state->stack_high; sp++) {
caml_oldify_one (*sp, sp);
}
/* Local C roots */ /* FIXME do the old-frame trick ? */
- for (lr = caml_local_roots; lr != NULL; lr = lr->next) {
+ for (lr = Caml_state->local_roots; lr != NULL; lr = lr->next) {
for (i = 0; i < lr->ntables; i++){
for (j = 0; j < lr->nitems; j++){
sp = &(lr->tables[i][j]);
caml_scan_global_young_roots(&caml_oldify_one);
/* Finalised values */
caml_final_oldify_young_roots ();
+ /* Memprof */
+ caml_memprof_scan_roots (&caml_oldify_one);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
}
f(caml_global_data, &caml_global_data);
CAML_INSTR_TIME (tmr, "major_roots/global");
/* The stack and the local C roots */
- caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots);
+ caml_do_local_roots(f, Caml_state->extern_sp, Caml_state->stack_high,
+ Caml_state->local_roots);
CAML_INSTR_TIME (tmr, "major_roots/local");
/* Global C roots */
caml_scan_global_roots(f);
/* Finalised values */
caml_final_do_roots (f);
CAML_INSTR_TIME (tmr, "major_roots/finalised");
+ /* Memprof */
+ caml_memprof_scan_roots (f);
+ CAML_INSTR_TIME (tmr, "major_roots/memprof");
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
CAML_INSTR_TIME (tmr, "major_roots/hook");
#include "caml/mlvalues.h"
#include "caml/stack.h"
#include "caml/roots.h"
+#include "caml/memprof.h"
#include <string.h>
#include <stdio.h>
/* Roots registered from C functions */
-struct caml__roots_block *caml_local_roots = NULL;
-
void (*caml_scan_roots_hook) (scanning_action) = NULL;
/* The hashtable of frame descriptors */
/* Communication with [caml_start_program] and [caml_call_gc]. */
-char * caml_top_of_stack;
-char * caml_bottom_of_stack = NULL; /* no stack initially */
-uintnat caml_last_return_address = 1; /* not in OCaml code initially */
-value * caml_gc_regs;
intnat caml_globals_inited = 0;
static intnat caml_globals_scanned = 0;
static link * caml_dyn_globals = NULL;
}
/* The stack and local roots */
- sp = caml_bottom_of_stack;
- retaddr = caml_last_return_address;
- regs = caml_gc_regs;
+ sp = Caml_state->bottom_of_stack;
+ retaddr = Caml_state->last_return_address;
+ regs = Caml_state->gc_regs;
if (sp != NULL) {
while (1) {
/* Find the descriptor corresponding to the return address */
}
}
/* Local C roots */
- for (lr = caml_local_roots; lr != NULL; lr = lr->next) {
+ for (lr = Caml_state->local_roots; lr != NULL; lr = lr->next) {
for (i = 0; i < lr->ntables; i++){
for (j = 0; j < lr->nitems; j++){
root = &(lr->tables[i][j]);
caml_scan_global_young_roots(&caml_oldify_one);
/* Finalised values */
caml_final_oldify_young_roots ();
+ /* Memprof */
+ caml_memprof_scan_roots (&caml_oldify_one);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
}
}
CAML_INSTR_TIME (tmr, "major_roots/dynamic_global");
/* The stack and local roots */
- caml_do_local_roots(f, caml_bottom_of_stack, caml_last_return_address,
- caml_gc_regs, caml_local_roots);
+ caml_do_local_roots(f, Caml_state->bottom_of_stack,
+ Caml_state->last_return_address, Caml_state->gc_regs,
+ Caml_state->local_roots);
CAML_INSTR_TIME (tmr, "major_roots/local");
/* Global C roots */
caml_scan_global_roots(f);
/* Finalised values */
caml_final_do_roots (f);
CAML_INSTR_TIME (tmr, "major_roots/finalised");
+ /* Memprof */
+ caml_memprof_scan_roots (f);
+ CAML_INSTR_TIME (tmr, "major_roots/memprof");
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
CAML_INSTR_TIME (tmr, "major_roots/hook");
uintnat caml_stack_usage (void)
{
uintnat sz;
- sz = (value *) caml_top_of_stack - (value *) caml_bottom_of_stack;
+ sz = (value *) Caml_state->top_of_stack -
+ (value *) Caml_state->bottom_of_stack;
if (caml_stack_usage_hook != NULL)
sz += (*caml_stack_usage_hook)();
return sz;
#define Addrglobal(reg,glob) \
lgrl reg, glob@GOTENT
-#define Loadglobal(reg,glob) \
- lgrl %r1, glob@GOTENT; lg reg, 0(%r1)
-#define Storeglobal(reg,glob) \
- lgrl %r1, glob@GOTENT; stg reg, 0(%r1)
-#define Loadglobal32(reg,glob) \
- lgrl %r1, glob@GOTENT; lgf reg, 0(%r1)
-#define Storeglobal32(reg,glob) \
- lgrl %r1, glob@GOTENT; sty reg, 0(%r1)
-
#else
#define Addrglobal(reg,glob) \
larl reg, glob
-#define Loadglobal(reg,glob) \
- lgrl reg, glob
-#define Storeglobal(reg,glob) \
- stgrl reg, glob
-#define Loadglobal32(reg,glob) \
- lgfrl reg, glob
-#define Storeglobal32(reg,glob) \
- strl reg, glob
-
#endif
+ .set domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+ .equ domain_field_caml_##name, domain_curr_field ; \
+ .set domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) 8*domain_field_caml_##var(%r10)
+
.section ".text"
/* Invoke the garbage collector. */
#define FRAMESIZE (16*8 + 16*8)
lay %r15, -FRAMESIZE(%r15)
/* Record return address into OCaml code */
- Storeglobal(%r14, caml_last_return_address)
+ stg %r14, Caml_state(last_return_address)
/* Record lowest stack address */
lay %r0, FRAMESIZE(%r15)
- Storeglobal(%r0, caml_bottom_of_stack)
+ stg %r0, Caml_state(bottom_of_stack)
/* Record pointer to register array */
lay %r0, (8*16)(%r15)
- Storeglobal(%r0, caml_gc_regs)
+ stg %r0, Caml_state(gc_regs)
/* Save current allocation pointer for debugging purposes */
- Storeglobal(%r11, caml_young_ptr)
+ stg %r11, Caml_state(young_ptr)
/* Save exception pointer (if e.g. a sighandler raises) */
- Storeglobal(%r13, caml_exception_pointer)
+ stg %r13, Caml_state(exception_pointer)
/* Save all registers used by the code generator */
stmg %r2,%r9, (8*16)(%r15)
stg %r12, (8*16 + 8*8)(%r15)
std %f14, 112(%r15)
std %f15, 120(%r15)
/* Call the GC */
- lay %r15, -160(%r15)
+ lay %r15, -160(%r15)
stg %r15, 0(%r15)
brasl %r14, caml_garbage_collection@PLT
- lay %r15, 160(%r15)
- /* Reload new allocation pointer and allocation limit */
- Loadglobal(%r11, caml_young_ptr)
- Loadglobal(%r10, caml_young_limit)
+ lay %r15, 160(%r15)
+ /* Reload new allocation pointer */
+ lg %r11, Caml_state(young_ptr)
/* Restore all regs used by the code generator */
lmg %r2,%r9, (8*16)(%r15)
lg %r12, (8*16 + 8*8)(%r15)
ld %f14, 112(%r15)
ld %f15, 120(%r15)
/* Return to caller */
- Loadglobal(%r1, caml_last_return_address)
+ lg %r1, Caml_state(last_return_address)
/* Deallocate stack frame */
lay %r15, FRAMESIZE(%r15)
/* Return */
- br %r1
+ br %r1
/* Call a C function from OCaml */
.globl caml_c_call
.type caml_c_call, @function
caml_c_call:
- Storeglobal(%r15, caml_bottom_of_stack)
+ stg %r15, Caml_state(bottom_of_stack)
.L101:
/* Save return address */
ldgr %f15, %r14
/* Get ready to call C function (address in r7) */
/* Record lowest stack address and return address */
- Storeglobal(%r14, caml_last_return_address)
+ stg %r14, Caml_state(last_return_address)
/* Make the exception handler and alloc ptr available to the C code */
- Storeglobal(%r11, caml_young_ptr)
- Storeglobal(%r13, caml_exception_pointer)
+ stg %r11, Caml_state(young_ptr)
+ stg %r13, Caml_state(exception_pointer)
/* Call the function */
basr %r14, %r7
/* restore return address */
lgdr %r14,%f15
- /* Reload allocation pointer and allocation limit*/
- Loadglobal(%r11, caml_young_ptr)
- Loadglobal(%r10, caml_young_limit)
+ /* Reload allocation pointer */
+ lg %r11, Caml_state(young_ptr)
/* Return to caller */
br %r14
.globl caml_raise_exn
.type caml_raise_exn, @function
caml_raise_exn:
- Loadglobal32(%r0, caml_backtrace_active)
+ lg %r0, Caml_state(backtrace_active)
cgfi %r0, 0
jne .L110
.L111:
/* Pop trap frame */
lg %r1, 0(%r13)
lgr %r15, %r13
- lg %r13, 8(13)
- agfi %r15, 16
+ lg %r13, 8(13)
+ agfi %r15, 16
/* Branch to handler */
br %r1
.L110:
ldgr %f15, %r2 /* preserve exn bucket in callee-save reg */
- /* arg1: exception bucket, already in r3 */
- lgr %r3,%r14 /* arg2: PC of raise */
+ /* arg1: exception bucket, already in r2 */
+ lgr %r3, %r14 /* arg2: PC of raise */
lgr %r4, %r15 /* arg3: SP of raise */
- lgr %r5, %r13 /* arg4: SP of handler */
- agfi %r15, -160 /* reserve stack space for C call */
+ lgr %r5, %r13 /* arg4: SP of handler */
+ agfi %r15, -160 /* reserve stack space for C call */
brasl %r14, caml_stash_backtrace@PLT
agfi %r15, 160
lgdr %r2,%f15 /* restore exn bucket */
.globl caml_raise_exception
.type caml_raise_exception, @function
caml_raise_exception:
- Loadglobal32(%r0, caml_backtrace_active)
+ lgr %r10, %r2 /* Load domain state pointer */
+ lgr %r2, %r3 /* Move exception bucket to arg1 register */
+ lg %r0, Caml_state(backtrace_active)
cgfi %r0, 0
jne .L112
.L113:
/* Reload OCaml global registers */
- Loadglobal(%r15, caml_exception_pointer)
- Loadglobal(%r11, caml_young_ptr)
- Loadglobal(%r10, caml_young_limit)
+ lg %r15, Caml_state(exception_pointer)
+ lg %r11, Caml_state(young_ptr)
/* Pop trap frame */
lg %r1, 0(%r15)
lg %r13, 8(%r15)
/* Branch to handler */
br %r1;
.L112:
- lgfi %r0, 0
- Storeglobal32(%r0, caml_backtrace_pos)
+ lgfi %r0, 0
+ stg %r0, Caml_state(backtrace_pos)
ldgr %f15,%r2 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r2 */
- Loadglobal(%r3, caml_last_return_address) /* arg2: PC of raise */
- Loadglobal(%r4, caml_bottom_of_stack) /* arg3: SP of raise */
- Loadglobal(%r5, caml_exception_pointer) /* arg4: SP of handler */
- /* reserve stack space for C call */
- lay %r15, -160(%r15)
+ lg %r3, Caml_state(last_return_address) /* arg2: PC of raise */
+ lg %r4, Caml_state(bottom_of_stack) /* arg3: SP of raise */
+ lg %r5, Caml_state(exception_pointer) /* arg4: SP of handler */
+ /* reserve stack space for C call */
+ lay %r15, -160(%r15)
brasl %r14, caml_stash_backtrace@PLT
- lay %r15, 160(%r15)
+ lay %r15, 160(%r15)
lgdr %r2,%f15 /* restore exn bucket */
j .L113 /* raise the exn */
.globl caml_start_program
.type caml_start_program, @function
caml_start_program:
+ /* Move Caml_state passed as first argument to r1 */
+ lgr %r1, %r2
Addrglobal(%r0, caml_program)
/* Code shared between caml_start_program and caml_callback */
std %f14, 120(%r15)
std %f15, 128(%r15)
+ /* Load Caml_state to r10 register */
+ lgr %r10, %r1
/* Set up a callback link */
lay %r15, -32(%r15)
- Loadglobal(%r1, caml_bottom_of_stack)
+ lg %r1, Caml_state(bottom_of_stack)
stg %r1, 0(%r15)
- Loadglobal(%r1, caml_last_return_address)
+ lg %r1, Caml_state(last_return_address)
stg %r1, 8(%r15)
- Loadglobal(%r1, caml_gc_regs)
+ lg %r1, Caml_state(gc_regs)
stg %r1, 16(%r15)
/* Build an exception handler to catch exceptions escaping out of OCaml */
brasl %r14, .L103
.L103:
lay %r15, -16(%r15)
stg %r14, 0(%r15)
- Loadglobal(%r1, caml_exception_pointer)
+ lg %r1, Caml_state(exception_pointer)
stg %r1, 8(%r15)
lgr %r13, %r15
- /* Reload allocation pointers */
- Loadglobal(%r11, caml_young_ptr)
- Loadglobal(%r10, caml_young_limit)
+ /* Reload allocation pointer */
+ lg %r11, Caml_state(young_ptr)
/* Call the OCaml code */
- lgr %r1,%r0
- basr %r14, %r1
+ lgr %r1,%r0
+ basr %r14, %r1
.L105:
/* Pop the trap frame, restoring caml_exception_pointer */
- lg %r0, 8(%r15)
- Storeglobal(%r0, caml_exception_pointer)
+ lg %r0, 8(%r15)
+ stg %r0, Caml_state(exception_pointer)
la %r15, 16(%r15)
/* Pop the callback link, restoring the global variables */
.L106:
lg %r5, 0(%r15)
lg %r6, 8(%r15)
lg %r0, 16(%r15)
- Storeglobal(%r5, caml_bottom_of_stack)
- Storeglobal(%r6, caml_last_return_address)
- Storeglobal(%r0, caml_gc_regs)
+ stg %r5, Caml_state(bottom_of_stack)
+ stg %r6, Caml_state(last_return_address)
+ stg %r0, Caml_state(gc_regs)
la %r15, 32(%r15)
/* Update allocation pointer */
- Storeglobal(%r11, caml_young_ptr)
+ stg %r11, Caml_state(young_ptr)
- /* Restore registers */
- lmg %r6,%r14, 0(%r15)
- ld %f8, 72(%r15)
- ld %f9, 80(%r15)
- ld %f10, 88(%r15)
- ld %f11, 96(%r15)
- ld %f12, 104(%r15)
- ld %f13, 112(%r15)
- ld %f14, 120(%r15)
- ld %f15, 128(%r15)
+ /* Restore registers */
+ lmg %r6,%r14, 0(%r15)
+ ld %f8, 72(%r15)
+ ld %f9, 80(%r15)
+ ld %f10, 88(%r15)
+ ld %f11, 96(%r15)
+ ld %f12, 104(%r15)
+ ld %f13, 112(%r15)
+ ld %f14, 120(%r15)
+ ld %f15, 128(%r15)
/* Return */
lay %r15, 144(%r15)
/* The trap handler: */
.L104:
/* Update caml_exception_pointer */
- Storeglobal(%r13, caml_exception_pointer)
+ stg %r13, Caml_state(exception_pointer)
/* Encode exception bucket as an exception result and return it */
oill %r2, 2
j .L106
/* Callback from C to OCaml */
- .globl caml_callback_exn
- .type caml_callback_exn, @function
-caml_callback_exn:
+ .globl caml_callback_asm
+ .type caml_callback_asm, @function
+caml_callback_asm:
/* Initial shuffling of arguments */
- lgr %r0, %r2 /* Closure */
- lgr %r2, %r3 /* Argument */
- lgr %r3, %r0
- lg %r0, 0(%r3) /* Code pointer */
+ /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1) */
+ lgr %r1, %r2 /* r1 = Caml_state */
+ lg %r2, 0(%r4) /* r2 = Argument */
+ /* r3 = Closure */
+ lg %r0, 0(%r3) /* r0 = Code pointer */
j .L102
- .globl caml_callback2_exn
- .type caml_callback2_exn, @function
-caml_callback2_exn:
- lgr %r0, %r2 /* Closure */
- lgr %r2, %r3 /* First argument */
- lgr %r3, %r4 /* Second argument */
- lgr %r4, %r0
- Addrglobal(%r0, caml_apply2)
+ .globl caml_callback2_asm
+ .type caml_callback2_asm, @function
+caml_callback2_asm:
+ /* Initial shuffling of arguments */
+ /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2) */
+ lgr %r1, %r2 /* r1 = Caml_state */
+ lgr %r0, %r3
+ lg %r2, 0(%r4) /* r2 = First argument */
+ lg %r3, 8(%r4) /* r3 = Second argument */
+ lgr %r4, %r0 /* r4 = Closure */
+ Addrglobal(%r0, caml_apply2) /* r0 = Code pointer */
j .L102
- .globl caml_callback3_exn
- .type caml_callback3_exn, @function
-caml_callback3_exn:
- lgr %r0, %r2 /* Closure */
- lgr %r2, %r3 /* First argument */
- lgr %r3, %r4 /* Second argument */
- lgr %r4, %r5 /* Third argument */
- lgr %r5, %r0
- Addrglobal(%r0, caml_apply3)
+ .globl caml_callback3_asm
+ .type caml_callback3_asm, @function
+caml_callback3_asm:
+ /* Initial shuffling of arguments */
+ /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2,
+ 16(r4) = arg3) */
+ lgr %r1, %r2 /* r1 = Caml_state */
+ lgr %r5, %r3 /* r5 = Closure */
+ lg %r2, 0(%r4) /* r2 = First argument */
+ lg %r3, 8(%r4) /* r3 = Second argument */
+ lg %r4, 16(%r4) /* r4 = Third argument */
+ Addrglobal(%r0, caml_apply3) /* r0 = Code pointer */
j .L102
.globl caml_ml_array_bound_error
caml_ml_array_bound_error:
/* Save return address before decrementing SP, otherwise
the frame descriptor for the call site is not correct */
- Storeglobal(%r15, caml_bottom_of_stack)
+ stg %r15, Caml_state(bottom_of_stack)
lay %r15, -160(%r15) /* Reserve stack space for C call */
Addrglobal(%r7, caml_array_bound_error)
j .L101
#include "caml/signals.h"
#include "caml/signals_machdep.h"
#include "caml/sys.h"
+#include "caml/memprof.h"
+#include "caml/finalise.h"
#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
#include "caml/spacetime.h"
#define NSIG 64
#endif
+CAMLexport int volatile caml_something_to_do = 0;
+
/* The set of pending signals (received but not yet processed) */
-CAMLexport intnat volatile caml_signals_are_pending = 0;
+static intnat volatile signals_are_pending = 0;
CAMLexport intnat volatile caml_pending_signals[NSIG];
#ifdef POSIX_SIGNALS
/* Execute all pending signals */
-void caml_process_pending_signals(void)
+value caml_process_pending_signals_exn(void)
{
int i;
int really_pending;
sigset_t set;
#endif
- if(!caml_signals_are_pending)
- return;
- caml_signals_are_pending = 0;
+ if(!signals_are_pending)
+ return Val_unit;
+ signals_are_pending = 0;
/* Check that there is indeed a pending signal before issuing the
syscall in [caml_sigmask_hook]. */
break;
}
if(!really_pending)
- return;
+ return Val_unit;
#ifdef POSIX_SIGNALS
caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set);
continue;
#endif
caml_pending_signals[i] = 0;
- caml_execute_signal(i, 0);
+ {
+ value exn = caml_execute_signal_exn(i, 0);
+ if (Is_exception_result(exn)) return exn;
+ }
}
+ return Val_unit;
+}
+
+CAMLno_tsan /* When called from [caml_record_signal], these memory
+ accesses may not be synchronized. */
+void caml_set_action_pending(void)
+{
+ caml_something_to_do = 1;
+
+ /* When this function is called without [caml_c_call] (e.g., in
+ [caml_modify]), this is only moderately effective on ports that cache
+ [Caml_state->young_limit] in a register, so it may take a while before the
+ register is reloaded from [Caml_state->young_limit]. */
+ Caml_state->young_limit = Caml_state->young_alloc_end;
}
/* Record the delivery of a signal, and arrange for it to be processed
as soon as possible:
- - in bytecode: via caml_something_to_do, processed in caml_process_event
- - in native-code: by playing with the allocation limit, processed
- in caml_garbage_collection
+ - via caml_something_to_do, processed in
+ caml_process_pending_actions_exn.
+ - by playing with the allocation limit, processed in
+ caml_garbage_collection and caml_alloc_small_dispatch.
*/
-void caml_record_signal(int signal_number)
+CAMLno_tsan void caml_record_signal(int signal_number)
{
caml_pending_signals[signal_number] = 1;
- caml_signals_are_pending = 1;
-#ifndef NATIVE_CODE
- caml_something_to_do = 1;
-#else
- caml_young_limit = caml_young_alloc_end;
-#endif
+ signals_are_pending = 1;
+ caml_set_action_pending();
}
/* Management of blocking sections. */
CAMLexport int (*caml_try_leave_blocking_section_hook)(void) =
caml_try_leave_blocking_section_default;
+CAMLno_tsan /* The read of [caml_something_to_do] is not synchronized. */
CAMLexport void caml_enter_blocking_section(void)
{
while (1){
/* Process all pending signals now */
- caml_process_pending_signals();
+ caml_raise_if_exception(caml_process_pending_signals_exn());
caml_enter_blocking_section_hook ();
/* Check again for pending signals.
If none, done; otherwise, try again */
- if (! caml_signals_are_pending) break;
+ if (! signals_are_pending) break;
caml_leave_blocking_section_hook ();
}
}
caml_leave_blocking_section_hook ();
/* Some other thread may have switched
- [caml_signals_are_pending] to 0 even though there are still
+ [signals_are_pending] to 0 even though there are still
pending signals (masked in the other thread). To handle this
case, we force re-examination of all signals by setting it back
to 1.
Another case where this is necessary (even in a single threaded
setting) is when the blocking section unmasks a pending signal:
If the signal is pending and masked but has already been
- examinated by [caml_process_pending_signals], then
- [caml_signals_are_pending] is 0 but the signal needs to be
+ examined by [caml_process_pending_signals_exn], then
+ [signals_are_pending] is 0 but the signal needs to be
handled at this point. */
- caml_signals_are_pending = 1;
- caml_process_pending_signals();
+ signals_are_pending = 1;
+ caml_raise_if_exception(caml_process_pending_signals_exn());
errno = saved_errno;
}
static value caml_signal_handlers = 0;
-void caml_execute_signal(int signal_number, int in_signal_handler)
+value caml_execute_signal_exn(int signal_number, int in_signal_handler)
{
value res;
value handler;
#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
/* Handled action may have no associated handler, which we interpret
as meaning the signal should be handled by a call to exit. This is
- is used to allow spacetime profiles to be completed on interrupt */
+ used to allow spacetime profiles to be completed on interrupt */
if (caml_signal_handlers == 0) {
res = caml_sys_exit(Val_int(2));
} else {
caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
}
#endif
- if (Is_exception_result(res)) caml_raise(Extract_exception(res));
+ return res;
}
-/* Arrange for a garbage collection to be performed as soon as possible */
+void caml_update_young_limit (void)
+{
+ /* The minor heap grows downwards. The first trigger is the largest one. */
+ Caml_state->young_limit =
+ caml_memprof_young_trigger < Caml_state->young_trigger ?
+ Caml_state->young_trigger : caml_memprof_young_trigger;
+
+ if(caml_something_to_do)
+ Caml_state->young_limit = Caml_state->young_alloc_end;
+}
-int volatile caml_requested_major_slice = 0;
-int volatile caml_requested_minor_gc = 0;
+/* Arrange for a garbage collection to be performed as soon as possible */
void caml_request_major_slice (void)
{
- caml_requested_major_slice = 1;
-#ifndef NATIVE_CODE
- caml_something_to_do = 1;
-#else
- caml_young_limit = caml_young_alloc_end;
- /* This is only moderately effective on ports that cache [caml_young_limit]
- in a register, since [caml_modify] is called directly, not through
- [caml_c_call], so it may take a while before the register is reloaded
- from [caml_young_limit]. */
-#endif
+ Caml_state->requested_major_slice = 1;
+ caml_set_action_pending();
}
void caml_request_minor_gc (void)
{
- caml_requested_minor_gc = 1;
-#ifndef NATIVE_CODE
- caml_something_to_do = 1;
-#else
- caml_young_limit = caml_young_alloc_end;
- /* Same remark as above in [caml_request_major_slice]. */
-#endif
+ Caml_state->requested_minor_gc = 1;
+ caml_set_action_pending();
+}
+
+value caml_do_pending_actions_exn(void)
+{
+ value exn;
+
+ caml_something_to_do = 0;
+
+ // Do any pending minor collection or major slice
+ caml_check_urgent_gc(Val_unit);
+
+ caml_update_young_limit();
+
+ // Call signal handlers first
+ exn = caml_process_pending_signals_exn();
+ if (Is_exception_result(exn)) goto exception;
+
+ // Call memprof callbacks
+ exn = caml_memprof_handle_postponed_exn();
+ if (Is_exception_result(exn)) goto exception;
+
+ // Call finalisers
+ exn = caml_final_do_calls_exn();
+ if (Is_exception_result(exn)) goto exception;
+
+ return Val_unit;
+
+exception:
+ /* If an exception is raised during an asynchronous callback, then
+ it might be the case that we did not run all the callbacks we
+ needed. Therefore, we set [caml_something_to_do] again in order
+ to force reexamination of callbacks. */
+ caml_set_action_pending();
+ return exn;
+}
+
+CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */
+static inline value process_pending_actions_with_root_exn(value extra_root)
+{
+ if (caml_something_to_do) {
+ CAMLparam1(extra_root);
+ value exn = caml_do_pending_actions_exn();
+ if (Is_exception_result(exn))
+ CAMLreturn(exn);
+ CAMLdrop;
+ }
+ return extra_root;
+}
+
+value caml_process_pending_actions_with_root(value extra_root)
+{
+ value res = process_pending_actions_with_root_exn(extra_root);
+ return caml_raise_if_exception(res);
+}
+
+CAMLexport value caml_process_pending_actions_exn(void)
+{
+ return process_pending_actions_with_root_exn(Val_unit);
+}
+
+CAMLexport void caml_process_pending_actions(void)
+{
+ value exn = process_pending_actions_with_root_exn(Val_unit);
+ caml_raise_if_exception(exn);
}
/* OS-independent numbering of signals */
}
caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
}
- caml_process_pending_signals();
+ caml_raise_if_exception(caml_process_pending_signals_exn());
CAMLreturn (res);
}
#include <errno.h>
#include "caml/config.h"
#include "caml/memory.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
#include "caml/osdeps.h"
#include "caml/signals.h"
#include "caml/signals_machdep.h"
#define signal(sig,act) caml_win32_signal(sig,act)
#endif
-CAMLexport int volatile caml_something_to_do = 0;
-CAMLexport void (* volatile caml_async_action_hook)(void) = NULL;
-
-void caml_process_event(void)
-{
- void (*async_action)(void);
-
- caml_check_urgent_gc (Val_unit);
- caml_process_pending_signals();
- async_action = caml_async_action_hook;
- if (async_action != NULL) {
- caml_async_action_hook = NULL;
- (*async_action)();
- }
-}
-
static void handle_signal(int signal_number)
{
int saved_errno;
#endif
if (signal_number < 0 || signal_number >= NSIG) return;
if (caml_try_leave_blocking_section_hook()) {
- caml_execute_signal(signal_number, 1);
+ caml_raise_if_exception(caml_execute_signal_exn(signal_number, 1));
caml_enter_blocking_section_hook();
}else{
caml_record_signal(signal_number);
else
return 0;
}
+
+void caml_setup_stack_overflow_detection(void) {}
#include "signals_osdep.h"
#include "caml/stack.h"
#include "caml/spacetime.h"
-
-#ifdef HAS_STACK_OVERFLOW_DETECTION
-#include <sys/time.h>
-#include <sys/resource.h>
-#endif
+#include "caml/memprof.h"
+#include "caml/finalise.h"
#ifndef NSIG
#define NSIG 64
void caml_garbage_collection(void)
{
- caml_young_limit = caml_young_trigger;
- if (caml_requested_major_slice || caml_requested_minor_gc ||
- caml_young_ptr - caml_young_trigger < Max_young_whsize){
+ /* TEMPORARY: if we have just sampled an allocation in native mode,
+ we simply renew the sample to ignore it. Otherwise, renewing now
+ will not have any effect on the sampling distribution, because of
+ the memorylessness of the Bernoulli process.
+
+ FIXME: if the sampling rate is 1, this leads to infinite loop,
+ because we are using a binomial distribution in [memprof.c]. This
+ will go away when the sampling of natively allocated blocks will
+ be correctly implemented.
+ */
+ caml_memprof_renew_minor_sample();
+ if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc ||
+ Caml_state->young_ptr - Caml_state->young_trigger < Max_young_whsize){
caml_gc_dispatch ();
}
#ifdef WITH_SPACETIME
- if (caml_young_ptr == caml_young_alloc_end) {
+ if (Caml_state->young_ptr == Caml_state->young_alloc_end) {
caml_spacetime_automatic_snapshot();
}
#endif
- caml_process_pending_signals();
+ caml_raise_if_exception(caml_do_pending_actions_exn());
}
DECLARE_SIGNAL_HANDLER(handle_signal)
#endif
if (sig < 0 || sig >= NSIG) return;
if (caml_try_leave_blocking_section_hook ()) {
- caml_execute_signal(sig, 1);
+ caml_raise_if_exception(caml_execute_signal_exn(sig, 1));
caml_enter_blocking_section_hook();
} else {
caml_record_signal(sig);
- /* Some ports cache [caml_young_limit] in a register.
+ /* Some ports cache [Caml_state->young_limit] in a register.
Use the signal context to modify that register too, but only if
we are inside OCaml code (not inside C code). */
#if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT)
if (Is_in_code_area(CONTEXT_PC))
- CONTEXT_YOUNG_LIMIT = (context_reg) caml_young_limit;
+ CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit;
#endif
}
errno = saved_errno;
caml_sigmask_hook(SIG_UNBLOCK, &mask, NULL);
}
#endif
- caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
- caml_young_ptr = (value *) CONTEXT_YOUNG_PTR;
- caml_bottom_of_stack = (char *) CONTEXT_SP;
- caml_last_return_address = (uintnat) CONTEXT_PC;
+ Caml_state->exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
+ Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
+ Caml_state->bottom_of_stack = (char *) CONTEXT_SP;
+ Caml_state->last_return_address = (uintnat) CONTEXT_PC;
caml_array_bound_error();
}
#endif
/* Machine- and OS-dependent handling of stack overflow */
#ifdef HAS_STACK_OVERFLOW_DETECTION
+#ifndef CONTEXT_SP
+#error "CONTEXT_SP is required if HAS_STACK_OVERFLOW_DETECTION is defined"
+#endif
-static char * system_stack_top;
static char sig_alt_stack[SIGSTKSZ];
-#if defined(SYS_linux)
-/* PR#4746: recent Linux kernels with support for stack randomization
- silently add 2 Mb of stack space on top of RLIMIT_STACK.
- 2 Mb = 0x200000, to which we add 8 kB (=0x2000) for overshoot. */
-#define EXTRA_STACK 0x202000
-#else
-#define EXTRA_STACK 0x2000
-#endif
+/* Code compiled with ocamlopt never accesses more than
+ EXTRA_STACK bytes below the stack pointer. */
+#define EXTRA_STACK 256
#ifdef RETURN_AFTER_STACK_OVERFLOW
-extern void caml_stack_overflow(void);
+extern void caml_stack_overflow(caml_domain_state*);
#endif
+/* Address sanitizer is confused when running the stack overflow
+ handler in an alternate stack. We deactivate it for all the
+ functions used by the stack overflow handler. */
+CAMLno_asan
DECLARE_SIGNAL_HANDLER(segv_handler)
{
- struct rlimit limit;
struct sigaction act;
char * fault_addr;
/* Sanity checks:
- faulting address is word-aligned
- - faulting address is within the stack
+ - faulting address is on the stack, or within EXTRA_STACK of it
- we are in OCaml code */
fault_addr = CONTEXT_FAULTING_ADDRESS;
if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0
- && getrlimit(RLIMIT_STACK, &limit) == 0
- && fault_addr < system_stack_top
- && fault_addr >= system_stack_top - limit.rlim_cur - EXTRA_STACK
+ && fault_addr < Caml_state->top_of_stack
+ && (uintnat)fault_addr >= CONTEXT_SP - EXTRA_STACK
#ifdef CONTEXT_PC
&& Is_in_code_area(CONTEXT_PC)
#endif
handler, we jump to the asm function [caml_stack_overflow]
(from $ARCH.S). */
#ifdef CONTEXT_PC
+ CONTEXT_C_ARG_1 = (context_reg) Caml_state;
CONTEXT_PC = (context_reg) &caml_stack_overflow;
#else
#error "CONTEXT_PC must be defined if RETURN_AFTER_STACK_OVERFLOW is"
#else
/* Raise a Stack_overflow exception straight from this signal handler */
#if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER)
- caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
- caml_young_ptr = (value *) CONTEXT_YOUNG_PTR;
+ Caml_state->exception_pointer == (char *) CONTEXT_EXCEPTION_POINTER;
+ Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
#endif
caml_raise_stack_overflow();
#endif
}
#endif
- /* Stack overflow handling */
#ifdef HAS_STACK_OVERFLOW_DETECTION
{
stack_t stk;
SET_SIGACT(act, segv_handler);
act.sa_flags |= SA_ONSTACK | SA_NODEFER;
sigemptyset(&act.sa_mask);
- system_stack_top = (char *) &act;
if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); }
}
#endif
}
+
+void caml_setup_stack_overflow_detection(void)
+{
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+ stack_t stk;
+ stk.ss_sp = malloc(SIGSTKSZ);
+ stk.ss_size = SIGSTKSZ;
+ stk.ss_flags = 0;
+ if (stk.ss_sp)
+ sigaltstack(&stk, NULL);
+#endif
+}
sigact.sa_flags = SA_SIGINFO
typedef greg_t context_reg;
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
#define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP])
- #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14])
+ #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
#define CONTEXT_FAULTING_ADDRESS ((char *)context->uc_mcontext.gregs[REG_CR2])
typedef unsigned long long context_reg;
#define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss))
+ #define CONTEXT_C_ARG_1 (CONTEXT_STATE.CONTEXT_REG(rdi))
#define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(rip))
- #define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.CONTEXT_REG(r14))
#define CONTEXT_YOUNG_PTR (CONTEXT_STATE.CONTEXT_REG(r15))
#define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(rsp))
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
typedef unsigned long context_reg;
#define CONTEXT_PC (context->uc_mcontext.arm_pc)
+ #define CONTEXT_SP (context->uc_mcontext.arm_sp)
#define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.arm_fp)
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.arm_r8)
#define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
typedef unsigned long context_reg;
#define CONTEXT_PC (context->uc_mcontext.pc)
+ #define CONTEXT_SP (context->uc_mcontext.sp)
#define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.regs[26])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.regs[27])
#define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
typedef unsigned long context_reg;
#define CONTEXT_PC (context->uc_mcontext.mc_gpregs.gp_elr)
+ #define CONTEXT_SP (context->uc_mcontext.mc_gpregs.gp_sp)
#define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.mc_gpregs.gp_x[26])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.mc_gpregs.gp_x[27])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
typedef greg_t context_reg;
#define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP])
- #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14])
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+ #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
sigact.sa_flags = SA_SIGINFO
#define CONTEXT_PC (context->sc_rip)
- #define CONTEXT_EXCEPTION_POINTER (context->sc_r14)
+ #define CONTEXT_C_ARG_1 (context->sc_rdi)
+ #define CONTEXT_SP (context->sc_rsp)
#define CONTEXT_YOUNG_PTR (context->sc_r15)
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
sigact.sa_flags = SA_SIGINFO
#define CONTEXT_PC (_UC_MACHINE_PC(context))
- #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14])
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+ #define CONTEXT_SP (_UC_MACHINE_SP(context))
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
sigact.sa_flags = 0
#define CONTEXT_FAULTING_ADDRESS ((char *) context.cr2)
+ #define CONTEXT_PC (context.eip)
+ #define CONTEXT_SP (context.esp)
/****************** I386, BSD_ELF */
#if defined (__NetBSD__)
#define CONTEXT_PC (_UC_MACHINE_PC(context))
+ #define CONTEXT_SP (_UC_MACHINE_SP(context))
#else
#define CONTEXT_PC (context->sc_eip)
+ #define CONTEXT_SP (context->sc_esp)
#endif
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
#define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss))
#define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(eip))
+ #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(esp))
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
/****************** I386, Solaris x86 */
caml_call_gc only invokes OCaml functions in the following circumstances:
1. running an OCaml finaliser;
- 2. executing an OCaml signal handler.
- Both of these are done on the finaliser trie. Furthermore, both of
+ 2. executing an OCaml signal handler;
+ 3. executing memprof callbacks.
+ All of these are done on the finaliser trie. Furthermore, all of
these invocations start via caml_callback; the code in this file for
handling that (caml_spacetime_c_to_ocaml) correctly copes with that by
attaching a single "caml_start_program" node that can cope with any
uintnat wosize, struct ext_table** cached_frames)
{
#ifdef HAS_LIBUNWIND
- /* Given that [caml_last_return_address] is the most recent call site in
- OCaml code, and that we are now in C (or other) code called from that
+ /* Given that [Caml_state->last_return_address] is the most recent call site
+ in OCaml code, and that we are now in C (or other) code called from that
site, obtain a backtrace using libunwind and graft the most recent
- portion (everything back to but not including [caml_last_return_address])
+ portion (everything back to but not including [last_return_address])
onto the trie. See the important comment below regarding the fact that
call site, and not callee, addresses are recorded during this process.
}
if (!have_frames_already) {
- /* Get the stack backtrace as far as [caml_last_return_address]. */
+ /* Get the stack backtrace as far as [Caml_state->last_return_address]. */
ret = unw_getcontext(&ctx);
if (ret != UNW_ESUCCESS) {
while ((ret = unw_step(&cur)) > 0) {
unw_word_t ip;
unw_get_reg(&cur, UNW_REG_IP, &ip);
- if (caml_last_return_address == (uintnat) ip) {
+ if (Caml_state->last_return_address == (uintnat) ip) {
break;
}
else {
for (frame = frames->size - 1; frame >= innermost_frame; frame--) {
c_node_type expected_type;
void* pc = frames->contents[frame];
- CAMLassert (pc != (void*) caml_last_return_address);
+ CAMLassert (pc != (void*) Caml_state->last_return_address);
if (!for_allocation) {
expected_type = CALL;
value node;
/* Update the trie with the current backtrace, as far back as
- [caml_last_return_address], and leave the node hole pointer at
+ [Caml_state->last_return_address], and leave the node hole pointer at
the correct place for attachment of a [caml_start_program] node. */
#ifdef HAS_LIBUNWIND
v_stats = allocate_outside_heap(sizeof(gc_stats));
stats = (gc_stats*) v_stats;
- stats->minor_words = Val_long(caml_stat_minor_words);
- stats->promoted_words = Val_long(caml_stat_promoted_words);
+ stats->minor_words = Val_long(Caml_state->stat_minor_words);
+ stats->promoted_words = Val_long(Caml_state->stat_promoted_words);
stats->major_words =
- Val_long(((uintnat) caml_stat_major_words)
+ Val_long(((uintnat) Caml_state->stat_major_words)
+ ((uintnat) caml_allocated_words));
- stats->minor_collections = Val_long(caml_stat_minor_collections);
- stats->major_collections = Val_long(caml_stat_major_collections);
- stats->heap_words = Val_long(caml_stat_heap_wsz / sizeof(value));
- stats->heap_chunks = Val_long(caml_stat_heap_chunks);
- stats->compactions = Val_long(caml_stat_compactions);
- stats->top_heap_words = Val_long(caml_stat_top_heap_wsz / sizeof(value));
+ stats->minor_collections = Val_long(Caml_state->stat_minor_collections);
+ stats->major_collections = Val_long(Caml_state->stat_major_collections);
+ stats->heap_words = Val_long(Caml_state->stat_heap_wsz / sizeof(value));
+ stats->heap_chunks = Val_long(Caml_state->stat_heap_chunks);
+ stats->compactions = Val_long(Caml_state->stat_compactions);
+ stats->top_heap_words =
+ Val_long(Caml_state->stat_top_heap_wsz / sizeof(value));
return v_stats;
}
#include "caml/mlvalues.h"
#include "caml/stacks.h"
-CAMLexport value * caml_stack_low;
-CAMLexport value * caml_stack_high;
-CAMLexport value * caml_stack_threshold;
-CAMLexport value * caml_extern_sp;
-CAMLexport value * caml_trapsp;
-CAMLexport value * caml_trap_barrier;
value caml_global_data = 0;
uintnat caml_max_stack_size; /* also used in gc_ctrl.c */
void caml_init_stack (uintnat initial_max_size)
{
- caml_stack_low = (value *) caml_stat_alloc(Stack_size);
- caml_stack_high = caml_stack_low + Stack_size / sizeof (value);
- caml_stack_threshold = caml_stack_low + Stack_threshold / sizeof (value);
- caml_extern_sp = caml_stack_high;
- caml_trapsp = caml_stack_high;
- caml_trap_barrier = caml_stack_high + 1;
+ Caml_state->stack_low = (value *) caml_stat_alloc(Stack_size);
+ Caml_state->stack_high = Caml_state->stack_low + Stack_size / sizeof (value);
+ Caml_state->stack_threshold =
+ Caml_state->stack_low + Stack_threshold / sizeof (value);
+ Caml_state->extern_sp = Caml_state->stack_high;
+ Caml_state->trapsp = Caml_state->stack_high;
+ Caml_state->trap_barrier = Caml_state->stack_high + 1;
caml_max_stack_size = initial_max_size;
caml_gc_message (0x08, "Initial stack limit: %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
value * new_low, * new_high, * new_sp;
value * p;
- CAMLassert(caml_extern_sp >= caml_stack_low);
- size = caml_stack_high - caml_stack_low;
+ CAMLassert(Caml_state->extern_sp >= Caml_state->stack_low);
+ size = Caml_state->stack_high - Caml_state->stack_low;
do {
if (size >= caml_max_stack_size) caml_raise_stack_overflow();
size *= 2;
- } while (size < caml_stack_high - caml_extern_sp + required_space);
+ } while (size < Caml_state->stack_high - Caml_state->extern_sp
+ + required_space);
caml_gc_message (0x08, "Growing stack to %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
(uintnat) size * sizeof(value) / 1024);
new_high = new_low + size;
#define shift(ptr) \
- ((char *) new_high - ((char *) caml_stack_high - (char *) (ptr)))
+ ((char *) new_high - ((char *) Caml_state->stack_high - (char *) (ptr)))
- new_sp = (value *) shift(caml_extern_sp);
+ new_sp = (value *) shift(Caml_state->extern_sp);
memmove((char *) new_sp,
- (char *) caml_extern_sp,
- (caml_stack_high - caml_extern_sp) * sizeof(value));
- caml_stat_free(caml_stack_low);
- caml_trapsp = (value *) shift(caml_trapsp);
- caml_trap_barrier = (value *) shift(caml_trap_barrier);
- for (p = caml_trapsp; p < new_high; p = Trap_link(p))
+ (char *) Caml_state->extern_sp,
+ (Caml_state->stack_high - Caml_state->extern_sp) * sizeof(value));
+ caml_stat_free(Caml_state->stack_low);
+ Caml_state->trapsp = (value *) shift(Caml_state->trapsp);
+ Caml_state->trap_barrier = (value *) shift(Caml_state->trap_barrier);
+ for (p = Caml_state->trapsp; p < new_high; p = Trap_link(p))
Trap_link(p) = (value *) shift(Trap_link(p));
- caml_stack_low = new_low;
- caml_stack_high = new_high;
- caml_stack_threshold = caml_stack_low + Stack_threshold / sizeof (value);
- caml_extern_sp = new_sp;
+ Caml_state->stack_low = new_low;
+ Caml_state->stack_high = new_high;
+ Caml_state->stack_threshold =
+ Caml_state->stack_low + Stack_threshold / sizeof (value);
+ Caml_state->extern_sp = new_sp;
#undef shift
}
CAMLprim value caml_ensure_stack_capacity(value required_space)
{
asize_t req = Long_val(required_space);
- if (caml_extern_sp - req < caml_stack_low) caml_realloc_stack(req);
+ if (Caml_state->extern_sp - req < Caml_state->stack_low)
+ caml_realloc_stack(req);
return Val_unit;
}
void caml_change_max_stack_size (uintnat new_max_size)
{
- asize_t size = caml_stack_high - caml_extern_sp
+ asize_t size = Caml_state->stack_high - Caml_state->extern_sp
+ Stack_threshold / sizeof (value);
if (new_max_size < size) new_max_size = size;
uintnat caml_stack_usage(void)
{
uintnat sz;
- sz = caml_stack_high - caml_extern_sp;
+ sz = Caml_state->stack_high - Caml_state->extern_sp;
if (caml_stack_usage_hook != NULL)
sz += (*caml_stack_usage_hook)();
return sz;
#include "caml/startup_aux.h"
+#ifdef _WIN32
+extern void caml_win32_unregister_overflow_detection (void);
+#endif
+
CAMLexport header_t *caml_atom_table = NULL;
/* Initialize the atom table */
if (opt != NULL){
while (*opt != '\0'){
switch (*opt++){
- case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
+ case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
+ break;
case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p));
- break;
+ break;
case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;
case 'h': scanmult (opt, &caml_init_heap_wsz); break;
case 'H': scanmult (opt, &caml_use_huge_pages); break;
caml_free_shared_libs();
#endif
caml_stat_destroy_pool();
+#if defined(_WIN32) && defined(NATIVE_CODE)
+ caml_win32_unregister_overflow_detection();
+#endif
shutdown_happened = 1;
}
#include "caml/callback.h"
#include "caml/custom.h"
#include "caml/debugger.h"
+#include "caml/domain.h"
#include "caml/dynlink.h"
#include "caml/exec.h"
#include "caml/fail.h"
exit(0);
break;
default:
- caml_fatal_error("unknown option %s", caml_stat_strdup_of_os(argv[i]));
+ fprintf(stderr, "unknown option %s", caml_stat_strdup_of_os(argv[i]));
+ exit(127);
}
}
return i;
caml_ensure_spacetime_dot_o_is_included++;
+ /* Initialize the domain */
+ caml_init_domain();
+
/* Determine options */
#ifdef DEBUG
caml_verb_gc = 0x3F;
#endif
caml_init_custom_operations();
caml_ext_table_init(&caml_shared_libs_path, 8);
- caml_external_raise = NULL;
/* Determine position of bytecode file */
pos = 0;
if (fd < 0) {
pos = parse_command_line(argv);
- if (argv[pos] == 0)
- caml_fatal_error("no bytecode file specified");
+ if (argv[pos] == 0) {
+ fprintf(stderr, "no bytecode file specified");
+ exit(127);
+ }
exe_name = argv[pos];
fd = caml_attempt_open(&exe_name, &trail, 1);
switch(fd) {
case FILE_NOT_FOUND:
- caml_fatal_error("cannot find file '%s'",
+ fprintf(stderr, "cannot find file '%s'",
caml_stat_strdup_of_os(argv[pos]));
+ exit(127);
break;
case BAD_BYTECODE:
- caml_fatal_error(
+ fprintf(stderr,
"the file '%s' is not a bytecode executable file",
caml_stat_strdup_of_os(exe_name));
+ exit(127);
break;
case WRONG_MAGIC:
- caml_fatal_error(
+ fprintf(stderr,
"the file '%s' has not the right magic number: "\
"expected %s, got %s",
caml_stat_strdup_of_os(exe_name),
EXEC_MAGIC,
magicstr);
+ exit(127);
break;
}
}
_beginthread(caml_signal_thread, 4096, NULL);
#endif
/* Execute the program */
- caml_debugger(PROGRAM_START);
+ caml_debugger(PROGRAM_START, Val_unit);
res = caml_interprete(caml_start_code, caml_code_size);
if (Is_exception_result(res)) {
- caml_exn_bucket = Extract_exception(res);
+ Caml_state->exn_bucket = Extract_exception(res);
if (caml_debugger_in_use) {
- caml_extern_sp = &caml_exn_bucket; /* The debugger needs the
+ Caml_state->extern_sp = &Caml_state->exn_bucket; /* The debugger needs the
exception value.*/
- caml_debugger(UNCAUGHT_EXC);
+ caml_debugger(UNCAUGHT_EXC, Val_unit);
}
- caml_fatal_uncaught_exception(caml_exn_bucket);
+ caml_fatal_uncaught_exception(Caml_state->exn_bucket);
}
}
char_os * cds_file;
char_os * exe_name;
+ /* Initialize the domain */
+ caml_init_domain();
/* Determine options */
#ifdef DEBUG
caml_verb_gc = 0x3F;
}
exe_name = caml_executable_name();
if (exe_name == NULL) exe_name = caml_search_exe_in_path(argv[0]);
- caml_external_raise = NULL;
/* Initialize the abstract machine */
caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_code_size = code_size;
caml_init_code_fragments();
caml_init_debug_info();
- if (caml_debugger_in_use) {
- uintnat len, i;
- len = code_size / sizeof(opcode_t);
- caml_saved_code = (unsigned char *) caml_stat_alloc(len);
- for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i];
- }
#ifdef THREADED_CODE
caml_thread_code(caml_start_code, code_size);
#endif
/* Initialize system libraries */
caml_sys_init(exe_name, argv);
/* Execute the program */
- caml_debugger(PROGRAM_START);
+ caml_debugger(PROGRAM_START, Val_unit);
return caml_interprete(caml_start_code, caml_code_size);
}
section_table, section_table_size,
pooling, argv);
if (Is_exception_result(res)) {
- caml_exn_bucket = Extract_exception(res);
+ Caml_state->exn_bucket = Extract_exception(res);
if (caml_debugger_in_use) {
- caml_extern_sp = &caml_exn_bucket; /* The debugger needs the
+ Caml_state->extern_sp = &Caml_state->exn_bucket; /* The debugger needs the
exception value.*/
- caml_debugger(UNCAUGHT_EXC);
+ caml_debugger(UNCAUGHT_EXC, Val_unit);
}
- caml_fatal_uncaught_exception(caml_exn_bucket);
+ caml_fatal_uncaught_exception(Caml_state->exn_bucket);
}
}
#include "caml/backtrace.h"
#include "caml/custom.h"
#include "caml/debugger.h"
+#include "caml/domain.h"
#include "caml/fail.h"
#include "caml/freelist.h"
#include "caml/gc.h"
struct longjmp_buffer caml_termination_jmpbuf;
void (*caml_termination_hook)(void *) = NULL;
-extern value caml_start_program (void);
+extern value caml_start_program (caml_domain_state*);
extern void caml_init_ieee_floats (void);
extern void caml_init_signals (void);
#ifdef _WIN32
char_os * exe_name, * proc_self_exe;
char tos;
+ /* Initialize the domain */
+ caml_init_domain();
/* Determine options */
#ifdef DEBUG
caml_verb_gc = 0x3F;
caml_install_invalid_parameter_handler();
#endif
caml_init_custom_operations();
- caml_top_of_stack = &tos;
+ Caml_state->top_of_stack = &tos;
caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free, caml_init_major_window,
if (caml_termination_hook != NULL) caml_termination_hook(NULL);
return Val_unit;
}
- return caml_start_program();
+ return caml_start_program(Caml_state);
}
value caml_startup_exn(char_os **argv)
"n" is the actual length of the output.
Allocate a Caml string of length "n" and copy the characters into it. */
res = caml_alloc_string(n);
- memcpy(String_val(res), buf, n);
+ memcpy((char *)String_val(res), buf, n);
} else {
/* PR#7568: if the format is in the Caml heap, the following
caml_alloc_string could move or free the format. To prevent
Note that caml_alloc_string left room for a '\0' at position n,
so the size passed to _vsnprintf is n+1. */
va_start(args, format);
- _vsnprintf(String_val(res), n + 1, saved_format, args);
+ _vsnprintf((char *)String_val(res), n + 1, saved_format, args);
va_end(args);
caml_stat_free(saved_format);
}
if ((caml_verb_gc & 0x400) != 0) {
/* cf caml_gc_counters */
- double minwords = caml_stat_minor_words
- + (double) (caml_young_end - caml_young_ptr);
- double prowords = caml_stat_promoted_words;
- double majwords = caml_stat_major_words + (double) caml_allocated_words;
+ double minwords = Caml_state->stat_minor_words
+ + (double) (Caml_state->young_end - Caml_state->young_ptr);
+ double prowords = Caml_state->stat_promoted_words;
+ double majwords =
+ Caml_state->stat_major_words + (double) caml_allocated_words;
double allocated_words = minwords + majwords - prowords;
- intnat mincoll = caml_stat_minor_collections;
- intnat majcoll = caml_stat_major_collections;
- intnat heap_words = caml_stat_heap_wsz;
- intnat heap_chunks = caml_stat_heap_chunks;
- intnat top_heap_words = caml_stat_top_heap_wsz;
- intnat cpct = caml_stat_compactions;
+ intnat mincoll = Caml_state->stat_minor_collections;
+ intnat majcoll = Caml_state->stat_major_collections;
+ intnat heap_words = Caml_state->stat_heap_wsz;
+ intnat heap_chunks = Caml_state->stat_heap_chunks;
+ intnat top_heap_words = Caml_state->stat_top_heap_wsz;
+ intnat cpct = Caml_state->stat_compactions;
caml_gc_message(0x400, "allocated_words: %.0f\n", allocated_words);
caml_gc_message(0x400, "minor_words: %.0f\n", minwords);
caml_gc_message(0x400, "promoted_words: %.0f\n", prowords);
}
#ifndef NATIVE_CODE
- caml_debugger(PROGRAM_EXIT);
+ caml_debugger(PROGRAM_EXIT, Val_unit);
#endif
caml_instr_atexit ();
if (caml_cleanup_on_exit)
CAMLprim value caml_ephe_create (value len)
{
- return caml_ephemeron_create(Long_val(len));
+ value res = caml_ephemeron_create(Long_val(len));
+ // run memprof callbacks
+ return caml_process_pending_actions_with_root(res);
}
CAMLprim value caml_weak_create (value len)
value old = Field (ar, offset);
Field (ar, offset) = v;
if (!(Is_block (old) && Is_young (old))){
- add_to_ephe_ref_table (&caml_ephe_ref_table, ar, offset);
+ add_to_ephe_ref_table (Caml_state->ephe_ref_table, ar, offset);
}
}else{
Field (ar, offset) = v;
} else {
res = None_val;
}
+ // run memprof callbacks both for the option we are allocating here
+ // and the calling function.
+ caml_process_pending_actions();
CAMLreturn(res);
}
if(8 == loop){ /** One minor gc must be enough */
elt = Val_unit;
CAML_INSTR_INT ("force_minor/weak@", 1);
- caml_request_minor_gc ();
- caml_gc_dispatch ();
+ caml_minor_collection ();
} else {
/* cases where loop is between 0 to 7 and where loop is equal to 9 */
elt = caml_alloc (Wosize_val (v), Tag_val (v));
CAMLprim value caml_ephe_get_key_copy (value ar, value n)
{
value key;
- return optionalize(caml_ephemeron_get_key_copy(ar, Long_val(n), &key),
- &key);
+ int status = caml_ephemeron_get_key_copy(ar, Long_val(n), &key);
+ return optionalize(status, &key);
}
CAMLprim value caml_weak_get_copy (value ar, value n)
if(8 == loop){ /** One minor gc must be enough */
elt = Val_unit;
CAML_INSTR_INT ("force_minor/weak@", 1);
- caml_request_minor_gc ();
- caml_gc_dispatch ();
+ caml_minor_collection ();
} else {
/* cases where loop is between 0 to 7 and where loop is equal to 9 */
elt = caml_alloc (Wosize_val (v), Tag_val (v));
CAMLprim value caml_ephe_get_data_copy (value ar)
{
value data;
- return optionalize(caml_ephemeron_get_data_copy(ar, &data), &data);
+ int status = caml_ephemeron_get_data_copy(ar, &data);
+ return optionalize(status, &data);
}
CAMLexport int caml_ephemeron_key_is_set(value ar, mlsize_t offset)
static void out_of_memory(void)
{
- fprintf(stderr, "Out of memory while expanding command line\n");
- exit(2);
+ caml_fatal_error("out of memory while expanding command line");
}
static void store_argument(wchar_t * arg)
}
#else
-extern char *caml_exception_pointer;
-extern value *caml_young_ptr;
/* Do not use the macro from address_class.h here. */
#undef Is_in_code_area
faulting_address = exn_info->ExceptionRecord->ExceptionInformation[1];
/* refresh runtime parameters from registers */
- caml_exception_pointer = (char *) ctx->R14;
- caml_young_ptr = (value *) ctx->R15;
+ Caml_state->young_ptr = (value *) ctx->R15;
/* call caml_reset_stack(faulting_address) using the alternate stack */
alt_rsp = win32_alt_stack + sizeof(win32_alt_stack) / sizeof(uintnat);
}
#endif /* _WIN64 */
+static PVOID caml_stack_overflow_handle;
+
void caml_win32_overflow_detection(void)
{
- AddVectoredExceptionHandler(1, caml_stack_overflow_VEH);
+ caml_stack_overflow_handle =
+ AddVectoredExceptionHandler(1, caml_stack_overflow_VEH);
+ if (caml_stack_overflow_handle == NULL) {
+ caml_fatal_error("cannot install stack overflow detection");
+ }
+}
+
+void caml_win32_unregister_overflow_detection(void)
+{
+ RemoveVectoredExceptionHandler(caml_stack_overflow_handle);
}
#endif /* NATIVE_CODE */
/* Do not include final NULL */
retcode = win_wide_char_to_multi_byte(s, slen, NULL, 0);
v = caml_alloc_string(retcode);
- win_wide_char_to_multi_byte(s, slen, String_val(v), retcode);
+ win_wide_char_to_multi_byte(s, slen, (char *)String_val(v), retcode);
return v;
}
stdlib__string.cmi \
stdlib__random.cmi \
stdlib__printf.cmi \
+ stdlib__list.cmi \
stdlib__lazy.cmi \
stdlib__buffer.cmi \
stdlib__filename.cmi
stdlib__string.cmx \
stdlib__random.cmx \
stdlib__printf.cmx \
+ stdlib__list.cmx \
stdlib__lazy.cmx \
stdlib__buffer.cmx \
stdlib__filename.cmi
Note: All paths are given relative to the root of the repository.
-First, build the compiler. Run `./configure`, then `make world.opt`. See
+First, build the compiler. Run `./configure`, then `make`. See
link:../HACKING.adoc[].
To add a new module, you must:
* Create new `.mli` and `.ml` files for the modules, obviously.
-* Define the module in `stdlib/stdlib.mli`, `stdlib/stdlib.ml`, and
- `otherlibs/threads/stdlib.ml` in the section of the code commented,
- "MODULE ALIASES". Please maintain the same style as the rest of the code, in
- particular the alphabetical ordering and whitespace alignment of module
- aliases. Note that `otherlibs/threads/stdlib.mli` is a symbolic link to
- `stdlib/stdlib.mli`.
-
-* Add `$(P)module_name.cmo` to the definition of `OTHERS` in `stdlib/Makefile`.
-
-* Add `$(LIB)/$(P)module_name.cmo` to the definition of `LIB_OBJS` in
- `otherlibs/threads/Makefile`.
+* Define the module in `stdlib/stdlib.mli` and `stdlib/stdlib.ml` in
+ the section of the code commented "MODULE ALIASES". Please maintain
+ the same style as the rest of the code, in particular the
+ alphabetical ordering and whitespace alignment of module aliases.
* Add `$(P)module_name` to the definition of `STDLIB_MODULES` in
- `stdlib/StdlibModules`. Please maintain the alphabetical order.
+ `stdlib/StdlibModules`. You must keep the list sorted in dependency order.
* Run `make alldepend` to update all the `.depend` files. These files are not
edited by hand.
-* Run `make clean` or `make partialclean`, then `make world.opt`.
+* Run `make clean` or `make partialclean`, then `make`.
If you are adding multiple modules, follow the steps above and rebuild the
compiler after adding each module. If you add multiple modules before
else
OPTCOMPFLAGS=
endif
+ifeq "$(FUNCTION_SECTIONS)" "true"
+OPTCOMPFLAGS += -function-sections
+endif
OPTCOMPILER=$(ROOTDIR)/ocamlopt
CAMLOPT=$(CAMLRUN) $(OPTCOMPILER)
CAMLDEP=$(BOOT_OCAMLC) -depend
# Object file prefix
P=stdlib__
-OBJS=camlinternalFormatBasics.cmo stdlib.cmo $(OTHERS)
-OTHERS= $(P)pervasives.cmo $(P)seq.cmo $(P)option.cmo $(P)result.cmo \
- $(P)bool.cmo $(P)char.cmo $(P)uchar.cmo $(P)sys.cmo $(P)list.cmo \
- $(P)bytes.cmo $(P)string.cmo $(P)unit.cmo \
- $(P)marshal.cmo $(P)obj.cmo $(P)array.cmo $(P)float.cmo \
- $(P)int.cmo $(P)int32.cmo $(P)int64.cmo $(P)nativeint.cmo \
- $(P)lexing.cmo $(P)parsing.cmo \
- $(P)set.cmo $(P)map.cmo $(P)stack.cmo $(P)queue.cmo \
- camlinternalLazy.cmo $(P)lazy.cmo $(P)stream.cmo \
- $(P)buffer.cmo camlinternalFormat.cmo $(P)printf.cmo \
- $(P)arg.cmo $(P)printexc.cmo $(P)fun.cmo $(P)gc.cmo \
- $(P)digest.cmo $(P)random.cmo $(P)hashtbl.cmo $(P)weak.cmo \
- $(P)format.cmo $(P)scanf.cmo $(P)callback.cmo \
- camlinternalOO.cmo $(P)oo.cmo camlinternalMod.cmo \
- $(P)genlex.cmo $(P)ephemeron.cmo \
- $(P)filename.cmo $(P)complex.cmo \
- $(P)arrayLabels.cmo $(P)listLabels.cmo $(P)bytesLabels.cmo \
- $(P)stringLabels.cmo $(P)moreLabels.cmo $(P)stdLabels.cmo \
- $(P)spacetime.cmo $(P)bigarray.cmo
+include StdlibModules
+
+OBJS=$(addsuffix .cmo,$(STDLIB_MODULES))
+OTHERS=$(filter-out camlinternalFormatBasics.cmo stdlib.cmo,$(OBJS))
PREFIXED_OBJS=$(filter stdlib__%.cmo,$(OBJS))
UNPREFIXED_OBJS=$(PREFIXED_OBJS:stdlib__%.cmo=%)
TARGETHEADERPROGRAM = target_$(HEADERPROGRAM)
+# The shebang test in configure.ac will need updating if any runtime is
+# introduced with a suffix more than one character long (camlheader_ur doesn't
+# matter).
CAMLHEADERS =\
camlheader target_camlheader camlheader_ur \
camlheaderd target_camlheaderd \
# The % in pattern rules must always match something, hence the slightly strange
# patterns and $(subst ...) since `camlheader%:` wouldn't match `camlheader`
-ifeq "$(HASHBANGSCRIPTS)" "true"
+ifeq "$(SHEBANGSCRIPTS)" "true"
camlhead%: $(ROOTDIR)/Makefile.config Makefile
+ifeq "$(LONG_SHEBANG)" "true"
+ echo '#!/bin/sh' > $@
+ echo 'exec "$(BINDIR)/ocamlrun$(subst er,,$*)" "$$0" "$$@"' >> $@
+else
echo '#!$(BINDIR)/ocamlrun$(subst er,,$*)' > $@
+endif
+# TODO This does not take long shebangs into account (since TARGET_BINDIR is not
+# yet processed by configure)
target_%: $(ROOTDIR)/Makefile.config Makefile
echo '#!$(TARGET_BINDIR)/ocamlrun$(subst camlheader,,$*)' > $@
strip $@
endif
+$(HEADERPROGRAM)%$(O): \
+ OC_CPPFLAGS += -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"'
+
$(HEADERPROGRAM)%$(O): $(HEADERPROGRAM).c
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) \
- -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"' \
- $(OUTPUTOBJ)$@ $^
+ $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $^
camlheader_ur: camlheader
cp camlheader $@
cp $< $@
endif
-endif # ifeq "$(HASHBANGSCRIPTS)" "true"
+endif # ifeq "$(SHEBANGSCRIPTS)" "true"
stdlib.cma: $(OBJS)
$(CAMLC) -a -o $@ $^
P ?= stdlib__
+# Modules should be listed in dependency order.
+
STDLIB_MODULES=\
- $(P)spacetime \
- $(P)arg \
- $(P)array \
- $(P)arrayLabels \
- $(P)bigarray \
- $(P)bool \
- $(P)buffer \
- $(P)bytes \
- $(P)bytesLabels \
- $(P)callback \
- camlinternalFormat \
camlinternalFormatBasics \
- camlinternalLazy \
- camlinternalMod \
- camlinternalOO \
+ stdlib \
+ $(P)pervasives \
+ $(P)seq \
+ $(P)option \
+ $(P)result \
+ $(P)bool \
$(P)char \
- $(P)complex \
- $(P)digest \
- $(P)ephemeron \
- $(P)filename \
+ $(P)uchar \
+ $(P)sys \
+ $(P)list \
+ $(P)bytes \
+ $(P)string \
+ $(P)unit \
+ $(P)marshal \
+ $(P)obj \
+ $(P)array \
$(P)float \
- $(P)format \
- $(P)fun \
- $(P)gc \
- $(P)genlex \
- $(P)hashtbl \
$(P)int \
$(P)int32 \
$(P)int64 \
- $(P)lazy \
- $(P)lexing \
- $(P)list \
- $(P)listLabels \
- $(P)map \
- $(P)marshal \
- $(P)moreLabels \
$(P)nativeint \
- $(P)obj \
- $(P)oo \
- $(P)option \
+ $(P)lexing \
$(P)parsing \
- $(P)pervasives \
- $(P)printexc \
- $(P)printf \
- $(P)queue \
- $(P)random \
- $(P)result \
- $(P)scanf \
- $(P)seq \
$(P)set \
+ $(P)map \
$(P)stack \
- $(P)stdLabels \
- stdlib \
+ $(P)queue \
+ camlinternalLazy \
+ $(P)lazy \
$(P)stream \
- $(P)string \
+ $(P)buffer \
+ camlinternalFormat \
+ $(P)printf \
+ $(P)arg \
+ $(P)printexc \
+ $(P)fun \
+ $(P)gc \
+ $(P)digest \
+ $(P)random \
+ $(P)hashtbl \
+ $(P)weak \
+ $(P)format \
+ $(P)scanf \
+ $(P)callback \
+ camlinternalOO \
+ $(P)oo \
+ camlinternalMod \
+ $(P)genlex \
+ $(P)ephemeron \
+ $(P)filename \
+ $(P)complex \
+ $(P)arrayLabels \
+ $(P)listLabels \
+ $(P)bytesLabels \
$(P)stringLabels \
- $(P)sys \
- $(P)uchar \
- $(P)unit \
- $(P)weak
+ $(P)moreLabels \
+ $(P)stdLabels \
+ $(P)spacetime \
+ $(P)bigarray
external concat : 'a array list -> 'a array = "caml_array_concat"
external unsafe_blit :
'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
+external unsafe_fill :
+ 'a array -> int -> int -> 'a -> unit = "caml_array_fill"
external create_float: int -> float array = "caml_make_float_vect"
let make_float = create_float
let fill a ofs len v =
if ofs < 0 || len < 0 || ofs > length a - len
then invalid_arg "Array.fill"
- else for i = ofs to ofs + len - 1 do unsafe_set a i v done
+ else unsafe_fill a ofs len v
let blit a1 ofs1 a2 ofs2 len =
if len < 0 || ofs1 < 0 || ofs1 > length a1 - len
(* *)
(**************************************************************************)
+(** Array operations
+
+ This module is intended to be used via {!StdLabels} which replaces
+ {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts
+
+ For example:
+ {[
+ open StdLabels
+
+ let everything = Array.create_matrix ~dimx:42 ~dimy:42 42
+ ]} *)
+
type 'a t = 'a array
(** An alias for the type of arrays. *)
-(** Array operations. *)
-
external length : 'a array -> int = "%array_length"
(** Return the length (number of elements) of the given array. *)
external get : 'a array -> int -> 'a = "%array_safe_get"
-(** [Array.get a n] returns the element number [n] of array [a].
+(** [get a n] returns the element number [n] of array [a].
The first element has number 0.
- The last element has number [Array.length a - 1].
- You can also write [a.(n)] instead of [Array.get a n].
+ The last element has number [length a - 1].
+ You can also write [a.(n)] instead of [get a n].
- Raise [Invalid_argument "index out of bounds"]
- if [n] is outside the range 0 to [(Array.length a - 1)]. *)
+ @raise Invalid_argument
+ if [n] is outside the range 0 to [(length a - 1)]. *)
external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
-(** [Array.set a n x] modifies array [a] in place, replacing
+(** [set a n x] modifies array [a] in place, replacing
element number [n] with [x].
- You can also write [a.(n) <- x] instead of [Array.set a n x].
+ You can also write [a.(n) <- x] instead of [set a n x].
- Raise [Invalid_argument "index out of bounds"]
- if [n] is outside the range 0 to [Array.length a - 1]. *)
+ @raise Invalid_argument
+ if [n] is outside the range 0 to [length a - 1]. *)
external make : int -> 'a -> 'a array = "caml_make_vect"
-(** [Array.make n x] returns a fresh array of length [n],
+(** [make n x] returns a fresh array of length [n],
initialized with [x].
All the elements of this new array are initially
physically equal to [x] (in the sense of the [==] predicate).
of the array, and modifying [x] through one of the array entries
will modify all other entries at the same time.
- Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length].
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
If the value of [x] is a floating-point number, then the maximum
size is only [Sys.max_array_length / 2].*)
external create : int -> 'a -> 'a array = "caml_make_vect"
[@@ocaml.deprecated "Use Array.make instead."]
-(** @deprecated [Array.create] is an alias for {!Array.make}. *)
+(** @deprecated [create] is an alias for {!make}. *)
val init : int -> f:(int -> 'a) -> 'a array
-(** [Array.init n f] returns a fresh array of length [n],
+(** [init n ~f] returns a fresh array of length [n],
with element number [i] initialized to the result of [f i].
- In other terms, [Array.init n f] tabulates the results of [f]
+ In other terms, [init n ~f] tabulates the results of [f]
applied to the integers [0] to [n-1].
- Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length].
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
If the return type of [f] is [float], then the maximum
size is only [Sys.max_array_length / 2].*)
val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
-(** [Array.make_matrix dimx dimy e] returns a two-dimensional array
+(** [make_matrix ~dimx ~dimy e] returns a two-dimensional array
(an array of arrays) with first dimension [dimx] and
second dimension [dimy]. All the elements of this new matrix
are initially physically equal to [e].
The element ([x,y]) of a matrix [m] is accessed
with the notation [m.(x).(y)].
- Raise [Invalid_argument] if [dimx] or [dimy] is negative or
+ @raise Invalid_argument if [dimx] or [dimy] is negative or
greater than {!Sys.max_array_length}.
If the value of [e] is a floating-point number, then the maximum
size is only [Sys.max_array_length / 2]. *)
val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
[@@ocaml.deprecated "Use Array.make_matrix instead."]
-(** @deprecated [Array.create_matrix] is an alias for
- {!Array.make_matrix}. *)
+(** @deprecated [create_matrix] is an alias for {!make_matrix}. *)
val append : 'a array -> 'a array -> 'a array
-(** [Array.append v1 v2] returns a fresh array containing the
+(** [append v1 v2] returns a fresh array containing the
concatenation of the arrays [v1] and [v2]. *)
val concat : 'a array list -> 'a array
-(** Same as {!Array.append}, but concatenates a list of arrays. *)
+(** Same as {!append}, but concatenates a list of arrays. *)
val sub : 'a array -> pos:int -> len:int -> 'a array
-(** [Array.sub a start len] returns a fresh array of length [len],
- containing the elements number [start] to [start + len - 1]
+(** [sub a ~pos ~len] returns a fresh array of length [len],
+ containing the elements number [pos] to [pos + len - 1]
of array [a].
- Raise [Invalid_argument "Array.sub"] if [start] and [len] do not
+ @raise Invalid_argument if [pos] and [len] do not
designate a valid subarray of [a]; that is, if
- [start < 0], or [len < 0], or [start + len > Array.length a]. *)
+ [pos < 0], or [len < 0], or [pos + len > length a]. *)
val copy : 'a array -> 'a array
-(** [Array.copy a] returns a copy of [a], that is, a fresh array
+(** [copy a] returns a copy of [a], that is, a fresh array
containing the same elements as [a]. *)
val fill : 'a array -> pos:int -> len:int -> 'a -> unit
-(** [Array.fill a ofs len x] modifies the array [a] in place,
- storing [x] in elements number [ofs] to [ofs + len - 1].
+(** [fill a ~pos ~len x] modifies the array [a] in place,
+ storing [x] in elements number [pos] to [pos + len - 1].
- Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not
+ @raise Invalid_argument if [pos] and [len] do not
designate a valid subarray of [a]. *)
val blit :
src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int ->
unit
-(** [Array.blit v1 o1 v2 o2 len] copies [len] elements
- from array [v1], starting at element number [o1], to array [v2],
- starting at element number [o2]. It works correctly even if
- [v1] and [v2] are the same array, and the source and
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] elements
+ from array [src], starting at element number [src_pos], to array [dst],
+ starting at element number [dst_pos]. It works correctly even if
+ [src] and [dst] are the same array, and the source and
destination chunks overlap.
- Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not
- designate a valid subarray of [v1], or if [o2] and [len] do not
- designate a valid subarray of [v2]. *)
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid subarray of [src], or if [dst_pos] and [len] do not
+ designate a valid subarray of [dst]. *)
val to_list : 'a array -> 'a list
-(** [Array.to_list a] returns the list of all the elements of [a]. *)
+(** [to_list a] returns the list of all the elements of [a]. *)
val of_list : 'a list -> 'a array
-(** [Array.of_list l] returns a fresh array containing the elements
+(** [of_list l] returns a fresh array containing the elements
of [l]. *)
val iter : f:('a -> unit) -> 'a array -> unit
-(** [Array.iter f a] applies function [f] in turn to all
+(** [iter ~f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
- [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *)
+ [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
val map : f:('a -> 'b) -> 'a array -> 'b array
-(** [Array.map f a] applies function [f] to all the elements of [a],
+(** [map ~f a] applies function [f] to all the elements of [a],
and builds an array with the results returned by [f]:
- [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *)
+ [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
val iteri : f:(int -> 'a -> unit) -> 'a array -> unit
-(** Same as {!Array.iter}, but the
+(** Same as {!iter}, but the
function is applied to the index of the element as first argument,
and the element itself as second argument. *)
val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array
-(** Same as {!Array.map}, but the
+(** Same as {!map}, but the
function is applied to the index of the element as first argument,
and the element itself as second argument. *)
val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a
-(** [Array.fold_left f x a] computes
- [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
+(** [fold_left ~f ~init a] computes
+ [f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a
-(** [Array.fold_right f a x] computes
- [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
+(** [fold_right ~f a ~init] computes
+ [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
where [n] is the length of the array [a]. *)
val iter2 : f:('a -> 'b -> unit) -> 'a array -> 'b array -> unit
-(** [Array.iter2 f a b] applies function [f] to all the elements of [a]
+(** [iter2 ~f a b] applies function [f] to all the elements of [a]
and [b].
- Raise [Invalid_argument] if the arrays are not the same size.
+ @raise Invalid_argument if the arrays are not the same size.
@since 4.05.0 *)
val map2 : f:('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
-(** [Array.map2 f a b] applies function [f] to all the elements of [a]
+(** [map2 ~f a b] applies function [f] to all the elements of [a]
and [b], and builds an array with the results returned by [f]:
- [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]].
- Raise [Invalid_argument] if the arrays are not the same size.
+ [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
+ @raise Invalid_argument if the arrays are not the same size.
@since 4.05.0 *)
val exists : f:('a -> bool) -> 'a array -> bool
-(** [Array.exists p [|a1; ...; an|]] checks if at least one element of
- the array satisfies the predicate [p]. That is, it returns
- [(p a1) || (p a2) || ... || (p an)].
+(** [exists ~f [|a1; ...; an|]] checks if at least one element of
+ the array satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)].
@since 4.03.0 *)
val for_all : f:('a -> bool) -> 'a array -> bool
-(** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array
- satisfy the predicate [p]. That is, it returns
- [(p a1) && (p a2) && ... && (p an)].
+(** [for_all ~f [|a1; ...; an|]] checks if all elements
+ of the array satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)].
@since 4.03.0 *)
val mem : 'a -> set:'a array -> bool
-(** [mem x a] is true if and only if [x] is equal
- to an element of [a].
+(** [mem x ~set] is true if and only if [x] is equal
+ to an element of [set].
@since 4.03.0 *)
val memq : 'a -> set:'a array -> bool
-(** Same as {!Array.mem}, but uses physical equality instead of structural
- equality to compare list elements.
+(** Same as {!mem}, but uses physical equality
+ instead of structural equality to compare list elements.
@since 4.03.0 *)
external create_float: int -> float array = "caml_make_float_vect"
-(** [Array.create_float n] returns a fresh float array of length [n],
+(** [create_float n] returns a fresh float array of length [n],
with uninitialized data.
@since 4.03 *)
val make_float: int -> float array
[@@ocaml.deprecated "Use Array.create_float instead."]
-(** @deprecated [Array.make_float] is an alias for
- {!Array.create_float}. *)
+(** @deprecated {!make_float} is an alias for
+ {!create_float}. *)
(** {1 Sorting} *)
and a negative integer if the first is smaller (see below for a
complete specification). For example, {!Stdlib.compare} is
a suitable comparison function, provided there are no floating-point
- NaN values in the data. After calling [Array.sort], the
+ NaN values in the data. After calling [sort], the
array is sorted in place in increasing order.
- [Array.sort] is guaranteed to run in constant heap space
+ [sort] is guaranteed to run in constant heap space
and (at most) logarithmic stack space.
The current implementation uses Heap Sort. It runs in constant
- [cmp x y] > 0 if and only if [cmp y x] < 0
- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
- When [Array.sort] returns, [a] contains the same elements as before,
+ When [sort] returns, [a] contains the same elements as before,
reordered in such a way that for all i and j valid indices of [a] :
- [cmp a.(i) a.(j)] >= 0 if and only if i >= j
*)
val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
-(** Same as {!Array.sort}, but the sorting algorithm is stable (i.e.
+(** Same as {!sort}, but the sorting algorithm is stable (i.e.
elements that compare equal are kept in their original order) and
not guaranteed to run in constant heap space.
The current implementation uses Merge Sort. It uses [n/2]
words of heap space, where [n] is the length of the array.
- It is usually faster than the current implementation of {!Array.sort}.
+ It is usually faster than the current implementation of {!sort}.
*)
val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
-(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is
- faster on typical input.
-*)
+(** Same as {!sort} or {!stable_sort}, whichever is faster on typical input. *)
(** {1 Iterators} *)
do not designate a valid range of [dst]. *)
val blit_string : string -> int -> bytes -> int -> int -> unit
-(** [blit src srcoff dst dstoff len] copies [len] bytes from string
- [src], starting at index [srcoff], to byte sequence [dst],
+(** [blit_string src srcoff dst dstoff len] copies [len] bytes from
+ string [src], starting at index [srcoff], to byte sequence [dst],
starting at index [dstoff].
Raise [Invalid_argument] if [srcoff] and [len] do not
Raise [Not_found] if [c] does not occur in [s] after position [i]. *)
val index_from_opt: bytes -> int -> char -> int option
-(** [index_from _opts i c] returns the index of the first occurrence of
+(** [index_from_opt s i c] returns the index of the first occurrence of
byte [c] in [s] after position [i] or [None] if [c] does not occur in [s]
after position [i].
[Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c].
(** Byte sequence operations.
@since 4.02.0
- *)
+
+ This module is intended to be used through {!StdLabels} which replaces
+ {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts.
+
+ For example:
+ {[
+ open StdLabels
+
+ let first = Bytes.sub ~pos:0 ~len:1
+ ]} *)
external length : bytes -> int = "%bytes_length"
(** Return the length (number of bytes) of the argument. *)
(* Default precision for float printing. *)
let default_float_precision fconv =
match snd fconv with
- | Float_f | Float_e | Float_E | Float_g | Float_G | Float_h | Float_H -> -6
- (* For %h and %H formats, a negative precision means "as many digits as
+ | Float_f | Float_e | Float_E | Float_g | Float_G | Float_h | Float_H
+ | Float_CF -> -6
+ (* For %h %H and %#F formats, a negative precision means "as many digits as
necessary". For the other FP formats, we take the absolute value
of the precision, hence 6 digits by default. *)
| Float_F -> 12
| Float_E -> 'E' | Float_g -> 'g'
| Float_G -> 'G' | Float_F -> cF
| Float_h -> 'h' | Float_H -> 'H'
+ | Float_CF -> 'F'
(* Convert a scanning counter to char. *)
(***)
-(* Print the optional '+' associated to a float conversion. *)
-let bprint_fconv_flag buf fconv = match fst fconv with
+(* Print the optional '+', ' ' and/or '#' associated to a float conversion. *)
+let bprint_fconv_flag buf fconv =
+ begin match fst fconv with
| Float_flag_p -> buffer_add_char buf '+'
| Float_flag_s -> buffer_add_char buf ' '
- | Float_flag_ -> ()
+ | Float_flag_ -> () end;
+ match snd fconv with
+ | Float_CF -> buffer_add_char buf '#'
+ | Float_f | Float_e | Float_E | Float_g | Float_G
+ | Float_F | Float_h | Float_H -> ()
(* Print a complete float format in a buffer (ex: "%+*.3f"). *)
let bprint_float_fmt buf ign_flag fconv pad prec =
bprint_precision buf prec;
buffer_add_char buf (char_of_fconv fconv)
-(* Compute the literal string representation of a formatting_lit. *)
-(* Also used by Printf and Scanf where formatting is not interpreted. *)
+(* Compute the literal string representation of a Formatting_lit. *)
+(* Used by Printf and Scanf where formatting is not interpreted. *)
let string_of_formatting_lit formatting_lit = match formatting_lit with
| Close_box -> "@]"
| Close_tag -> "@}"
| Escaped_percent -> "@%"
| Scan_indic c -> "@" ^ (String.make 1 c)
-(* Compute the literal string representation of a formatting. *)
-(* Also used by Printf and Scanf where formatting is not interpreted. *)
-let string_of_formatting_gen : type a b c d e f .
- (a, b, c, d, e, f) formatting_gen -> string =
- fun formatting_gen -> match formatting_gen with
- | Open_tag (Format (_, str)) -> str
- | Open_box (Format (_, str)) -> str
-
(***)
(* Print a literal char in a buffer, escape '%' by "%%". *)
bprint_string_literal buf (string_of_formatting_lit fmting_lit);
fmtiter rest ign_flag;
| Formatting_gen (fmting_gen, rest) ->
- bprint_string_literal buf "@{";
- bprint_string_literal buf (string_of_formatting_gen fmting_gen);
+ begin match fmting_gen with
+ | Open_tag (Format (_, str)) ->
+ buffer_add_string buf "@{"; buffer_add_string buf str
+ | Open_box (Format (_, str)) ->
+ buffer_add_string buf "@["; buffer_add_string buf str
+ end;
fmtiter rest ign_flag;
| End_of_format -> ()
(* Convert a float to string. *)
(* Fix special case of "OCaml float format". *)
let convert_float fconv prec x =
- match snd fconv with
- | Float_h | Float_H ->
+ let hex () =
let sign =
match fst fconv with
| Float_flag_p -> '+'
| Float_flag_s -> ' '
| _ -> '-' in
- let str = hexstring_of_float x prec sign in
- begin match snd fconv with
- | Float_H -> String.uppercase_ascii str
- | _ -> str
- end
- | _ ->
+ hexstring_of_float x prec sign in
+ let add_dot_if_needed str =
+ let len = String.length str in
+ let rec is_valid i =
+ if i = len then false else
+ match str.[i] with
+ | '.' | 'e' | 'E' -> true
+ | _ -> is_valid (i + 1) in
+ if is_valid 0 then str else str ^ "." in
+ let caml_special_val str = match classify_float x with
+ | FP_normal | FP_subnormal | FP_zero -> str
+ | FP_infinite -> if x < 0.0 then "neg_infinity" else "infinity"
+ | FP_nan -> "nan" in
+ match snd fconv with
+ | Float_h -> hex ()
+ | Float_H -> String.uppercase_ascii (hex ())
+ | Float_CF -> caml_special_val (hex ())
+ | Float_F ->
let str = format_float (format_of_fconv fconv prec) x in
- if snd fconv <> Float_F then str else
- let len = String.length str in
- let rec is_valid i =
- if i = len then false else
- match str.[i] with
- | '.' | 'e' | 'E' -> true
- | _ -> is_valid (i + 1)
- in
- match classify_float x with
- | FP_normal | FP_subnormal | FP_zero ->
- if is_valid 0 then str else str ^ "."
- | FP_infinite ->
- if x < 0.0 then "neg_infinity" else "infinity"
- | FP_nan -> "nan"
+ caml_special_val (add_dot_if_needed str)
+ | Float_f | Float_e | Float_E | Float_g | Float_G ->
+ format_float (format_of_fconv fconv prec) x
(* Convert a char to a string according to the OCaml lexical convention. *)
let format_caml_char c =
make_padprec_fmt_ebb (get_int_pad ()) (get_prec ()) fmt_rest in
Fmt_EBB (Int64 (iconv, pad', prec', fmt_rest'))
| 'f' | 'e' | 'E' | 'g' | 'G' | 'F' | 'h' | 'H' ->
- let fconv = compute_float_conv pct_ind str_ind (get_plus ())
- (get_space ()) symb in
+ let fconv =
+ compute_float_conv pct_ind str_ind
+ (get_plus ()) (get_hash ()) (get_space ()) symb in
let Fmt_EBB fmt_rest = parse str_ind end_ind in
if get_ign () then
let ignored = Ignored_float (get_pad_opt '_', get_prec_opt ()) in
let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
Fmt_EBB (Formatting_lit (Scan_indic c, fmt_rest))
- and check_open_box : type a b c d e f . (a, b, c, d, e, f) fmt -> unit =
- fun fmt -> match fmt with
- | String_literal (str, End_of_format) -> (
- try ignore (open_box_of_string str) with Failure _ ->
- ((* Emit warning: invalid open box *))
- )
- | _ -> ()
-
(* Try to read the optional <name> after "@{" or "@[". *)
and parse_tag : type e f . bool -> int -> int -> (_, _, e, f) fmt_ebb =
fun is_open_tag str_ind end_ind ->
let Fmt_EBB fmt_rest = parse (ind + 1) end_ind in
let Fmt_EBB sub_fmt = parse str_ind (ind + 1) in
let sub_format = Format (sub_fmt, sub_str) in
- let formatting = if is_open_tag then Open_tag sub_format else (
- check_open_box sub_fmt;
- Open_box sub_format) in
+ let formatting =
+ if is_open_tag then Open_tag sub_format else Open_box sub_format in
Fmt_EBB (Formatting_gen (formatting, fmt_rest))
| _ ->
raise Not_found
| false, _, false, _ -> assert false
(* Convert (plus, space, symb) to its associated float_conv. *)
- and compute_float_conv pct_ind str_ind plus space symb =
+ and compute_float_conv pct_ind str_ind plus hash space symb =
let flag = match plus, space with
| false, false -> Float_flag_
| false, true -> Float_flag_s
(* plus and space: legacy implementation prefers plus *)
if legacy_behavior then Float_flag_p
else incompatible_flag pct_ind str_ind ' ' "'+'" in
- let kind = match symb with
- | 'f' -> Float_f
- | 'e' -> Float_e
- | 'E' -> Float_E
- | 'g' -> Float_g
- | 'G' -> Float_G
- | 'h' -> Float_h
- | 'H' -> Float_H
- | 'F' -> Float_F
+ let kind = match hash, symb with
+ | _, 'f' -> Float_f
+ | _, 'e' -> Float_e
+ | _, 'E' -> Float_E
+ | _, 'g' -> Float_g
+ | _, 'G' -> Float_G
+ | _, 'h' -> Float_h
+ | _, 'H' -> Float_H
+ | false, 'F' -> Float_F
+ | true, 'F' -> Float_CF
| _ -> assert false in
flag, kind
val char_of_iconv : CamlinternalFormatBasics.int_conv -> char
val string_of_formatting_lit : CamlinternalFormatBasics.formatting_lit -> string
-val string_of_formatting_gen :
- ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.formatting_gen -> string
val string_of_fmtty :
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string
| Float_F (* %F | %+F | % F *)
| Float_h (* %h | %+h | % h *)
| Float_H (* %H | %+H | % H *)
+ | Float_CF (* %#F| %+#F| % #F *)
type float_conv = float_flag_conv * float_kind_conv
(***)
| Float_flag_ | Float_flag_p | Float_flag_s
type float_kind_conv =
| Float_f | Float_e | Float_E | Float_g | Float_G
- | Float_F | Float_h | Float_H
+ | Float_F | Float_h | Float_H | Float_CF
type float_conv = float_flag_conv * float_kind_conv
type char_set = string
then current_dir_name
else trailing_sep (String.length name - 1)
-module Unix = struct
+module type SYSDEPS = sig
+ val null : string
+ val current_dir_name : string
+ val parent_dir_name : string
+ val dir_sep : string
+ val is_dir_sep : string -> int -> bool
+ val is_relative : string -> bool
+ val is_implicit : string -> bool
+ val check_suffix : string -> string -> bool
+ val chop_suffix_opt : suffix:string -> string -> string option
+ val temp_dir_name : string
+ val quote : string -> string
+ val quote_command :
+ string -> ?stdin: string -> ?stdout: string -> ?stderr: string
+ -> string list -> string
+ val basename : string -> string
+ val dirname : string -> string
+end
+
+module Unix : SYSDEPS = struct
+ let null = "/dev/null"
let current_dir_name = "."
let parent_dir_name = ".."
let dir_sep = "/"
let temp_dir_name =
try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
let quote = generic_quote "'\\''"
+ let quote_command cmd ?stdin ?stdout ?stderr args =
+ String.concat " " (List.map quote (cmd :: args))
+ ^ (match stdin with None -> "" | Some f -> " <" ^ quote f)
+ ^ (match stdout with None -> "" | Some f -> " >" ^ quote f)
+ ^ (match stderr with None -> "" | Some f -> if stderr = stdout
+ then " 2>&1"
+ else " 2>" ^ quote f)
let basename = generic_basename is_dir_sep current_dir_name
let dirname = generic_dirname is_dir_sep current_dir_name
end
-module Win32 = struct
+module Win32 : SYSDEPS = struct
+ let null = "NUL"
let current_dir_name = "."
let parent_dir_name = ".."
let dir_sep = "\\"
in
loop 0;
Buffer.contents b
+(*
+Quoting commands for execution by cmd.exe is difficult.
+1- Each argument is first quoted using the "quote" function above, to
+ protect it against the processing performed by the C runtime system,
+ then cmd.exe's special characters are escaped with '^', using
+ the "quote_cmd" function below. For more details, see
+ https://blogs.msdn.microsoft.com/twistylittlepassagesallalike/2011/04/23
+2- The command and the redirection files, if any, must be double-quoted
+ in case they contain spaces. This quoting is interpreted by cmd.exe,
+ not by the C runtime system, hence the "quote" function above
+ cannot be used. The two characters we don't know how to quote
+ inside a double-quoted cmd.exe string are double-quote and percent.
+ We just fail if the command name or the redirection file names
+ contain a double quote (not allowed in Windows file names, anyway)
+ or a percent. See function "quote_cmd_filename" below.
+3- The whole string passed to Sys.command is then enclosed in double
+ quotes, which are immediately stripped by cmd.exe. Otherwise,
+ some of the double quotes from step 2 above can be misparsed.
+ See e.g. https://stackoverflow.com/a/9965141
+*)
+ let quote_cmd s =
+ let b = Buffer.create (String.length s + 20) in
+ String.iter
+ (fun c ->
+ match c with
+ | '(' | ')' | '!' | '^' | '%' | '\"' | '<' | '>' | '&' | '|' ->
+ Buffer.add_char b '^'; Buffer.add_char b c
+ | _ ->
+ Buffer.add_char b c)
+ s;
+ Buffer.contents b
+ let quote_cmd_filename f =
+ if String.contains f '\"' || String.contains f '%' then
+ failwith ("Filename.quote_command: bad file name " ^ f)
+ else if String.contains f ' ' then
+ "\"" ^ f ^ "\""
+ else
+ f
+ (* Redirections in cmd.exe: see https://ss64.com/nt/syntax-redirection.html
+ and https://docs.microsoft.com/en-us/previous-versions/windows/it-pro/windows-xp/bb490982(v=technet.10)
+ *)
+ let quote_command cmd ?stdin ?stdout ?stderr args =
+ String.concat "" [
+ "\"";
+ quote_cmd_filename cmd;
+ " ";
+ quote_cmd (String.concat " " (List.map quote args));
+ (match stdin with None -> "" | Some f -> " <" ^ quote_cmd_filename f);
+ (match stdout with None -> "" | Some f -> " >" ^ quote_cmd_filename f);
+ (match stderr with None -> "" | Some f ->
+ if stderr = stdout
+ then " 2>&1"
+ else " 2>" ^ quote_cmd_filename f);
+ "\""
+ ]
let has_drive s =
let is_letter = function
| 'A' .. 'Z' | 'a' .. 'z' -> true
generic_basename is_dir_sep current_dir_name path
end
-module Cygwin = struct
+module Cygwin : SYSDEPS = struct
+ let null = "/dev/null"
let current_dir_name = "."
let parent_dir_name = ".."
let dir_sep = "/"
let chop_suffix_opt = Win32.chop_suffix_opt
let temp_dir_name = Unix.temp_dir_name
let quote = Unix.quote
+ let quote_command = Unix.quote_command
let basename = generic_basename is_dir_sep current_dir_name
let dirname = generic_dirname is_dir_sep current_dir_name
end
-let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
- is_relative, is_implicit, check_suffix, chop_suffix_opt,
- temp_dir_name, quote, basename,
- dirname) =
- match Sys.os_type with
- | "Win32" ->
- (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
- Win32.is_dir_sep,
- Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
- Win32.chop_suffix_opt,
- Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname)
- | "Cygwin" ->
- (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep,
- Cygwin.is_dir_sep,
- Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
- Cygwin.chop_suffix_opt,
- Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
- | _ -> (* normally "Unix" *)
- (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
- Unix.is_dir_sep,
- Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
- Unix.chop_suffix_opt,
- Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
+module Sysdeps =
+ (val (match Sys.os_type with
+ | "Win32" -> (module Win32: SYSDEPS)
+ | "Cygwin" -> (module Cygwin: SYSDEPS)
+ | _ -> (module Unix: SYSDEPS)))
+
+include Sysdeps
let concat dirname filename =
let l = String.length dirname in
This function conforms to the specification of POSIX.1-2008 for the
[dirname] utility. *)
+val null : string
+(** [null] is ["/dev/null"] on POSIX and ["NUL"] on Windows. It represents a
+ file on the OS that discards all writes and returns end of file on reads.
+
+ @since 4.10.0 *)
+
val temp_file : ?temp_dir: string -> string -> string -> string
(** [temp_file prefix suffix] returns the name of a
fresh temporary file in the temporary directory.
with programs that follow the standard Windows quoting
conventions.
*)
+
+val quote_command :
+ string -> ?stdin:string -> ?stdout:string -> ?stderr:string
+ -> string list -> string
+(** [quote_command cmd args] returns a quoted command line, suitable
+ for use as an argument to {!Sys.command}, {!Unix.system}, and the
+ {!Unix.open_process} functions.
+
+ The string [cmd] is the command to call. The list [args] is
+ the list of arguments to pass to this command. It can be empty.
+
+ The optional arguments [?stdin] and [?stdout] and [?stderr] are
+ file names used to redirect the standard input, the standard
+ output, or the standard error of the command.
+ If [~stdin:f] is given, a redirection [< f] is performed and the
+ standard input of the command reads from file [f].
+ If [~stdout:f] is given, a redirection [> f] is performed and the
+ standard output of the command is written to file [f].
+ If [~stderr:f] is given, a redirection [2> f] is performed and the
+ standard error of the command is written to file [f].
+ If both [~stdout:f] and [~stderr:f] are given, with the exact
+ same file name [f], a [2>&1] redirection is performed so that the
+ standard output and the standard error of the command are interleaved
+ and redirected to the same file [f].
+
+ Under Unix and Cygwin, the command, the arguments, and the redirections
+ if any are quoted using {!Filename.quote}, then concatenated.
+ Under Win32, additional quoting is performed as required by the
+ [cmd.exe] shell that is called by {!Sys.command}.
+
+ Raise [Failure] if the command cannot be escaped on the current platform.
+*)
(* *)
(* OCaml *)
(* *)
-(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* Jacques-Henri Jourdan, projet Gallium, INRIA Paris *)
(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
+(* Copyright 1996-2016 Institut National de Recherche en Informatique *)
+(* et en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* *)
(* OCaml *)
(* *)
-(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* Damien Doligez, projet Para, INRIA Rocquencourt *)
+(* Jacques-Henri Jourdan, projet Gallium, INRIA Paris *)
(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
+(* Copyright 1996-2016 Institut National de Recherche en Informatique *)
+(* et en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
type stat =
{ minor_words : float;
(** Number of words allocated in the minor heap since
- the program was started. This number is accurate in
- byte-code programs, but only an approximation in programs
- compiled to native code. *)
+ the program was started. *)
promoted_words : float;
(** Number of words allocated in the minor heap that
(this setting is intended for testing purposes only).
If [max_overhead >= 1000000], compaction is never triggered.
If compaction is permanently disabled, it is strongly suggested
- to set [allocation_policy] to 1.
+ to set [allocation_policy] to 2.
Default: 500. *)
mutable stack_limit : int;
mutable allocation_policy : int;
[@ocaml.deprecated_mutable
"Use {(Gc.get()) with Gc.allocation_policy = ...}"]
- (** The policy used for allocating in the heap. Possible
- values are 0 and 1. 0 is the next-fit policy, which is
- quite fast but can result in fragmentation. 1 is the
- first-fit policy, which can be slower in some cases but
- can be better for programs with fragmentation problems.
- Default: 0. @since 3.11.0 *)
+ (** The policy used for allocating in the major heap.
+ Possible values are 0, 1 and 2.
+
+ - 0 is the next-fit policy, which is usually fast but can
+ result in fragmentation, increasing memory consumption.
+
+ - 1 is the first-fit policy, which avoids fragmentation but
+ has corner cases (in certain realistic workloads) where it
+ is sensibly slower.
+
+ - 2 is the best-fit policy, which is fast and avoids
+ fragmentation. In our experiments it is faster and uses less
+ memory than both next-fit and first-fit.
+ (since OCaml 4.10)
+
+ The current default is next-fit, as the best-fit policy is new
+ and not yet widely tested. We expect best-fit to become the
+ default in the future.
+
+ On one example that was known to be bad for next-fit and first-fit,
+ next-fit takes 28s using 855Mio of memory,
+ first-fit takes 47s using 566Mio of memory,
+ best-fit takes 27s using 545Mio of memory.
+
+ Note: When changing to a low-fragmentation policy, you may
+ need to augment the [space_overhead] setting, for example
+ using [100] instead of the default [80] which is tuned for
+ next-fit. Indeed, the difference in fragmentation behavior
+ means that different policies will have different proportion
+ of "wasted space" for a given program. Less fragmentation
+ means a smaller heap so, for the same amount of wasted space,
+ a higher proportion of wasted space. This makes the GC work
+ harder, unless you relax it by increasing [space_overhead].
+
+ Note: changing the allocation policy at run-time forces
+ a heap compaction, which is a lengthy operation unless the
+ heap is small (e.g. at the start of the program).
+
+ Default: 0.
+
+ @since 3.11.0 *)
window_size : int;
(** The size of the window used by the major GC for smoothing
(* Hash tables *)
-external seeded_hash_param :
- int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc]
-external old_hash_param :
- int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc]
-
-let hash x = seeded_hash_param 10 100 0 x
-let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x
-let seeded_hash seed x = seeded_hash_param 10 100 seed x
-
(* We do dynamic hashing, and resize the table and rehash the elements
when buckets become too long. *)
let prng = lazy (Random.State.make_self_init())
+(* Functions which appear before the functorial interface must either be
+ independent of the hash function or take it as a parameter (see #2202 and
+ code below the functor definitions. *)
+
(* Creating a fresh, empty table *)
let rec power_2_above x n =
{ initial_size = s; size = 0; seed = seed; data = Array.make s Empty }
let clear h =
- h.size <- 0;
- let len = Array.length h.data in
- for i = 0 to len - 1 do
- h.data.(i) <- Empty
- done
+ if h.size > 0 then begin
+ h.size <- 0;
+ Array.fill h.data 0 (Array.length h.data) Empty
+ end
let reset h =
let len = Array.length h.data in
done;
end
-let key_index h key =
- (* compatibility with old hash tables *)
- if Obj.size (Obj.repr h) >= 3
- then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1)
- else (old_hash_param 10 100 key) mod (Array.length h.data)
-
-let add h key data =
- let i = key_index h key in
- let bucket = Cons{key; data; next=h.data.(i)} in
- h.data.(i) <- bucket;
- h.size <- h.size + 1;
- if h.size > Array.length h.data lsl 1 then resize key_index h
-
-let rec remove_bucket h i key prec = function
- | Empty ->
- ()
- | (Cons {key=k; next}) as c ->
- if compare k key = 0
- then begin
- h.size <- h.size - 1;
- match prec with
- | Empty -> h.data.(i) <- next
- | Cons c -> c.next <- next
- end
- else remove_bucket h i key c next
-
-let remove h key =
- let i = key_index h key in
- remove_bucket h i key Empty h.data.(i)
-
-let rec find_rec key = function
- | Empty ->
- raise Not_found
- | Cons{key=k; data; next} ->
- if compare key k = 0 then data else find_rec key next
-
-let find h key =
- match h.data.(key_index h key) with
- | Empty -> raise Not_found
- | Cons{key=k1; data=d1; next=next1} ->
- if compare key k1 = 0 then d1 else
- match next1 with
- | Empty -> raise Not_found
- | Cons{key=k2; data=d2; next=next2} ->
- if compare key k2 = 0 then d2 else
- match next2 with
- | Empty -> raise Not_found
- | Cons{key=k3; data=d3; next=next3} ->
- if compare key k3 = 0 then d3 else find_rec key next3
-
-let rec find_rec_opt key = function
- | Empty ->
- None
- | Cons{key=k; data; next} ->
- if compare key k = 0 then Some data else find_rec_opt key next
-
-let find_opt h key =
- match h.data.(key_index h key) with
- | Empty -> None
- | Cons{key=k1; data=d1; next=next1} ->
- if compare key k1 = 0 then Some d1 else
- match next1 with
- | Empty -> None
- | Cons{key=k2; data=d2; next=next2} ->
- if compare key k2 = 0 then Some d2 else
- match next2 with
- | Empty -> None
- | Cons{key=k3; data=d3; next=next3} ->
- if compare key k3 = 0 then Some d3 else find_rec_opt key next3
-
-let find_all h key =
- let rec find_in_bucket = function
- | Empty ->
- []
- | Cons{key=k; data; next} ->
- if compare k key = 0
- then data :: find_in_bucket next
- else find_in_bucket next in
- find_in_bucket h.data.(key_index h key)
-
-let rec replace_bucket key data = function
- | Empty ->
- true
- | Cons ({key=k; next} as slot) ->
- if compare k key = 0
- then (slot.key <- key; slot.data <- data; false)
- else replace_bucket key data next
-
-let replace h key data =
- let i = key_index h key in
- let l = h.data.(i) in
- if replace_bucket key data l then begin
- h.data.(i) <- Cons{key; data; next=l};
- h.size <- h.size + 1;
- if h.size > Array.length h.data lsl 1 then resize key_index h
- end
-
-let mem h key =
- let rec mem_in_bucket = function
- | Empty ->
- false
- | Cons{key=k; next} ->
- compare k key = 0 || mem_in_bucket next in
- mem_in_bucket h.data.(key_index h key)
-
let iter f h =
let rec do_bucket = function
| Empty ->
let to_seq_values m = Seq.map snd (to_seq m)
-let add_seq tbl i =
- Seq.iter (fun (k,v) -> add tbl k v) i
-
-let replace_seq tbl i =
- Seq.iter (fun (k,v) -> replace tbl k v) i
-
-let of_seq i =
- let tbl = create 16 in
- replace_seq tbl i;
- tbl
-
(* Functorial interface *)
module type HashedType =
replace_seq tbl i;
tbl
end
+
+(* Polymorphic hash function-based tables *)
+(* Code included below the functorial interface to guard against accidental
+ use - see #2202 *)
+
+external seeded_hash_param :
+ int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc]
+external old_hash_param :
+ int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc]
+
+let hash x = seeded_hash_param 10 100 0 x
+let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x
+let seeded_hash seed x = seeded_hash_param 10 100 seed x
+
+let key_index h key =
+ (* compatibility with old hash tables *)
+ if Obj.size (Obj.repr h) >= 3
+ then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1)
+ else (old_hash_param 10 100 key) mod (Array.length h.data)
+
+let add h key data =
+ let i = key_index h key in
+ let bucket = Cons{key; data; next=h.data.(i)} in
+ h.data.(i) <- bucket;
+ h.size <- h.size + 1;
+ if h.size > Array.length h.data lsl 1 then resize key_index h
+
+let rec remove_bucket h i key prec = function
+ | Empty ->
+ ()
+ | (Cons {key=k; next}) as c ->
+ if compare k key = 0
+ then begin
+ h.size <- h.size - 1;
+ match prec with
+ | Empty -> h.data.(i) <- next
+ | Cons c -> c.next <- next
+ end
+ else remove_bucket h i key c next
+
+let remove h key =
+ let i = key_index h key in
+ remove_bucket h i key Empty h.data.(i)
+
+let rec find_rec key = function
+ | Empty ->
+ raise Not_found
+ | Cons{key=k; data; next} ->
+ if compare key k = 0 then data else find_rec key next
+
+let find h key =
+ match h.data.(key_index h key) with
+ | Empty -> raise Not_found
+ | Cons{key=k1; data=d1; next=next1} ->
+ if compare key k1 = 0 then d1 else
+ match next1 with
+ | Empty -> raise Not_found
+ | Cons{key=k2; data=d2; next=next2} ->
+ if compare key k2 = 0 then d2 else
+ match next2 with
+ | Empty -> raise Not_found
+ | Cons{key=k3; data=d3; next=next3} ->
+ if compare key k3 = 0 then d3 else find_rec key next3
+
+let rec find_rec_opt key = function
+ | Empty ->
+ None
+ | Cons{key=k; data; next} ->
+ if compare key k = 0 then Some data else find_rec_opt key next
+
+let find_opt h key =
+ match h.data.(key_index h key) with
+ | Empty -> None
+ | Cons{key=k1; data=d1; next=next1} ->
+ if compare key k1 = 0 then Some d1 else
+ match next1 with
+ | Empty -> None
+ | Cons{key=k2; data=d2; next=next2} ->
+ if compare key k2 = 0 then Some d2 else
+ match next2 with
+ | Empty -> None
+ | Cons{key=k3; data=d3; next=next3} ->
+ if compare key k3 = 0 then Some d3 else find_rec_opt key next3
+
+let find_all h key =
+ let rec find_in_bucket = function
+ | Empty ->
+ []
+ | Cons{key=k; data; next} ->
+ if compare k key = 0
+ then data :: find_in_bucket next
+ else find_in_bucket next in
+ find_in_bucket h.data.(key_index h key)
+
+let rec replace_bucket key data = function
+ | Empty ->
+ true
+ | Cons ({key=k; next} as slot) ->
+ if compare k key = 0
+ then (slot.key <- key; slot.data <- data; false)
+ else replace_bucket key data next
+
+let replace h key data =
+ let i = key_index h key in
+ let l = h.data.(i) in
+ if replace_bucket key data l then begin
+ h.data.(i) <- Cons{key; data; next=l};
+ h.size <- h.size + 1;
+ if h.size > Array.length h.data lsl 1 then resize key_index h
+ end
+
+let mem h key =
+ let rec mem_in_bucket = function
+ | Empty ->
+ false
+ | Cons{key=k; next} ->
+ compare k key = 0 || mem_in_bucket next in
+ mem_in_bucket h.data.(key_index h key)
+
+let add_seq tbl i =
+ Seq.iter (fun (k,v) -> add tbl k v) i
+
+let replace_seq tbl i =
+ Seq.iter (fun (k,v) -> replace tbl k v) i
+
+let of_seq i =
+ let tbl = create 16 in
+ replace_seq tbl i;
+ tbl
| [] -> None
| x :: l -> if p x then Some x else find_opt p l
+let rec find_map f = function
+ | [] -> None
+ | x :: l ->
+ begin match f x with
+ | Some _ as result -> result
+ | None -> find_map f l
+ end
+
let find_all p =
let rec find accu = function
| [] -> rev accu
in
aux []
+let concat_map f l =
+ let rec aux f acc = function
+ | [] -> rev acc
+ | x :: l ->
+ let xs = f x in
+ aux f (rev_append xs acc) l
+ in aux f [] l
+
let partition p l =
let rec part yes no = function
| [] -> (rev yes, rev no)
else h2 :: merge cmp l1 t2
-let rec chop k l =
- if k = 0 then l else begin
- match l with
- | _::t -> chop (k-1) t
- | _ -> assert false
- end
-
-
let stable_sort cmp l =
let rec rev_merge l1 l2 accu =
match l1, l2 with
in
let rec sort n l =
match n, l with
- | 2, x1 :: x2 :: _ ->
- if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1]
- | 3, x1 :: x2 :: x3 :: _ ->
- if cmp x1 x2 <= 0 then begin
- if cmp x2 x3 <= 0 then [x1; x2; x3]
- else if cmp x1 x3 <= 0 then [x1; x3; x2]
- else [x3; x1; x2]
- end else begin
- if cmp x1 x3 <= 0 then [x2; x1; x3]
- else if cmp x2 x3 <= 0 then [x2; x3; x1]
- else [x3; x2; x1]
- end
+ | 2, x1 :: x2 :: tl ->
+ let s = if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1] in
+ (s, tl)
+ | 3, x1 :: x2 :: x3 :: tl ->
+ let s =
+ if cmp x1 x2 <= 0 then
+ if cmp x2 x3 <= 0 then [x1; x2; x3]
+ else if cmp x1 x3 <= 0 then [x1; x3; x2]
+ else [x3; x1; x2]
+ else if cmp x1 x3 <= 0 then [x2; x1; x3]
+ else if cmp x2 x3 <= 0 then [x2; x3; x1]
+ else [x3; x2; x1]
+ in
+ (s, tl)
| n, l ->
- let n1 = n asr 1 in
- let n2 = n - n1 in
- let l2 = chop n1 l in
- let s1 = rev_sort n1 l in
- let s2 = rev_sort n2 l2 in
- rev_merge_rev s1 s2 []
+ let n1 = n asr 1 in
+ let n2 = n - n1 in
+ let s1, l2 = rev_sort n1 l in
+ let s2, tl = rev_sort n2 l2 in
+ (rev_merge_rev s1 s2 [], tl)
and rev_sort n l =
match n, l with
- | 2, x1 :: x2 :: _ ->
- if cmp x1 x2 > 0 then [x1; x2] else [x2; x1]
- | 3, x1 :: x2 :: x3 :: _ ->
- if cmp x1 x2 > 0 then begin
- if cmp x2 x3 > 0 then [x1; x2; x3]
- else if cmp x1 x3 > 0 then [x1; x3; x2]
- else [x3; x1; x2]
- end else begin
- if cmp x1 x3 > 0 then [x2; x1; x3]
- else if cmp x2 x3 > 0 then [x2; x3; x1]
- else [x3; x2; x1]
- end
+ | 2, x1 :: x2 :: tl ->
+ let s = if cmp x1 x2 > 0 then [x1; x2] else [x2; x1] in
+ (s, tl)
+ | 3, x1 :: x2 :: x3 :: tl ->
+ let s =
+ if cmp x1 x2 > 0 then
+ if cmp x2 x3 > 0 then [x1; x2; x3]
+ else if cmp x1 x3 > 0 then [x1; x3; x2]
+ else [x3; x1; x2]
+ else if cmp x1 x3 > 0 then [x2; x1; x3]
+ else if cmp x2 x3 > 0 then [x2; x3; x1]
+ else [x3; x2; x1]
+ in
+ (s, tl)
| n, l ->
- let n1 = n asr 1 in
- let n2 = n - n1 in
- let l2 = chop n1 l in
- let s1 = sort n1 l in
- let s2 = sort n2 l2 in
- rev_merge s1 s2 []
+ let n1 = n asr 1 in
+ let n2 = n - n1 in
+ let s1, l2 = sort n1 l in
+ let s2, tl = sort n2 l2 in
+ (rev_merge s1 s2 [], tl)
in
let len = length l in
- if len < 2 then l else sort len l
+ if len < 2 then l else fst (sort len l)
let sort = stable_sort
in
let rec sort n l =
match n, l with
- | 2, x1 :: x2 :: _ ->
- let c = cmp x1 x2 in
- if c = 0 then [x1]
- else if c < 0 then [x1; x2] else [x2; x1]
- | 3, x1 :: x2 :: x3 :: _ ->
- let c = cmp x1 x2 in
- if c = 0 then begin
- let c = cmp x2 x3 in
- if c = 0 then [x2]
- else if c < 0 then [x2; x3] else [x3; x2]
- end else if c < 0 then begin
- let c = cmp x2 x3 in
- if c = 0 then [x1; x2]
- else if c < 0 then [x1; x2; x3]
- else let c = cmp x1 x3 in
- if c = 0 then [x1; x2]
- else if c < 0 then [x1; x3; x2]
- else [x3; x1; x2]
- end else begin
- let c = cmp x1 x3 in
- if c = 0 then [x2; x1]
- else if c < 0 then [x2; x1; x3]
- else let c = cmp x2 x3 in
- if c = 0 then [x2; x1]
- else if c < 0 then [x2; x3; x1]
- else [x3; x2; x1]
- end
+ | 2, x1 :: x2 :: tl ->
+ let s =
+ let c = cmp x1 x2 in
+ if c = 0 then [x1] else if c < 0 then [x1; x2] else [x2; x1]
+ in
+ (s, tl)
+ | 3, x1 :: x2 :: x3 :: tl ->
+ let s =
+ let c = cmp x1 x2 in
+ if c = 0 then
+ let c = cmp x2 x3 in
+ if c = 0 then [x2] else if c < 0 then [x2; x3] else [x3; x2]
+ else if c < 0 then
+ let c = cmp x2 x3 in
+ if c = 0 then [x1; x2]
+ else if c < 0 then [x1; x2; x3]
+ else
+ let c = cmp x1 x3 in
+ if c = 0 then [x1; x2]
+ else if c < 0 then [x1; x3; x2]
+ else [x3; x1; x2]
+ else
+ let c = cmp x1 x3 in
+ if c = 0 then [x2; x1]
+ else if c < 0 then [x2; x1; x3]
+ else
+ let c = cmp x2 x3 in
+ if c = 0 then [x2; x1]
+ else if c < 0 then [x2; x3; x1]
+ else [x3; x2; x1]
+ in
+ (s, tl)
| n, l ->
- let n1 = n asr 1 in
- let n2 = n - n1 in
- let l2 = chop n1 l in
- let s1 = rev_sort n1 l in
- let s2 = rev_sort n2 l2 in
- rev_merge_rev s1 s2 []
+ let n1 = n asr 1 in
+ let n2 = n - n1 in
+ let s1, l2 = rev_sort n1 l in
+ let s2, tl = rev_sort n2 l2 in
+ (rev_merge_rev s1 s2 [], tl)
and rev_sort n l =
match n, l with
- | 2, x1 :: x2 :: _ ->
- let c = cmp x1 x2 in
- if c = 0 then [x1]
- else if c > 0 then [x1; x2] else [x2; x1]
- | 3, x1 :: x2 :: x3 :: _ ->
- let c = cmp x1 x2 in
- if c = 0 then begin
- let c = cmp x2 x3 in
- if c = 0 then [x2]
- else if c > 0 then [x2; x3] else [x3; x2]
- end else if c > 0 then begin
- let c = cmp x2 x3 in
- if c = 0 then [x1; x2]
- else if c > 0 then [x1; x2; x3]
- else let c = cmp x1 x3 in
- if c = 0 then [x1; x2]
- else if c > 0 then [x1; x3; x2]
- else [x3; x1; x2]
- end else begin
- let c = cmp x1 x3 in
- if c = 0 then [x2; x1]
- else if c > 0 then [x2; x1; x3]
- else let c = cmp x2 x3 in
- if c = 0 then [x2; x1]
- else if c > 0 then [x2; x3; x1]
- else [x3; x2; x1]
- end
+ | 2, x1 :: x2 :: tl ->
+ let s =
+ let c = cmp x1 x2 in
+ if c = 0 then [x1] else if c > 0 then [x1; x2] else [x2; x1]
+ in
+ (s, tl)
+ | 3, x1 :: x2 :: x3 :: tl ->
+ let s =
+ let c = cmp x1 x2 in
+ if c = 0 then
+ let c = cmp x2 x3 in
+ if c = 0 then [x2] else if c > 0 then [x2; x3] else [x3; x2]
+ else if c > 0 then
+ let c = cmp x2 x3 in
+ if c = 0 then [x1; x2]
+ else if c > 0 then [x1; x2; x3]
+ else
+ let c = cmp x1 x3 in
+ if c = 0 then [x1; x2]
+ else if c > 0 then [x1; x3; x2]
+ else [x3; x1; x2]
+ else
+ let c = cmp x1 x3 in
+ if c = 0 then [x2; x1]
+ else if c > 0 then [x2; x1; x3]
+ else
+ let c = cmp x2 x3 in
+ if c = 0 then [x2; x1]
+ else if c > 0 then [x2; x3; x1]
+ else [x3; x2; x1]
+ in
+ (s, tl)
| n, l ->
- let n1 = n asr 1 in
- let n2 = n - n1 in
- let l2 = chop n1 l in
- let s1 = sort n1 l in
- let s2 = sort n2 l2 in
- rev_merge s1 s2 []
+ let n1 = n asr 1 in
+ let n2 = n - n1 in
+ let s1, l2 = sort n1 l in
+ let s2, tl = sort n2 l2 in
+ (rev_merge s1 s2 [], tl)
in
let len = length l in
- if len < 2 then l else sort len l
+ if len < 2 then l else fst (sort len l)
+
let rec compare_lengths l1 l2 =
match l1, l2 with
@since 4.08.0
*)
+val concat_map : ('a -> 'b list) -> 'a list -> 'b list
+(** [List.concat_map f l] gives the same result as
+ {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive.
+
+ @since 4.10.0
+*)
+
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
(** [List.fold_left f a [b1; ...; bn]] is
[f (... (f (f a b1) b2) ...) bn]. *)
satisfies [p] in the list [l].
@since 4.05 *)
+val find_map: ('a -> 'b option) -> 'a list -> 'b option
+(** [find_map f l] applies [f] to the elements of [l] in order,
+ and returns the first result of the form [Some v], or [None]
+ if none exist.
+ @since 4.10.0
+*)
+
val filter : ('a -> bool) -> 'a list -> 'a list
(** [filter p l] returns all the elements of the list [l]
that satisfy the predicate [p]. The order of the elements
The above considerations can usually be ignored if your lists are not
longer than about 10000 elements.
-*)
+
+ This module is intended to be used through {!StdLabels} which replaces
+ {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts.
+
+ For example:
+ {[
+ open StdLabels
+
+ let seq len = List.init ~f:(function i -> i) ~len
+ ]} *)
val length : 'a list -> int
(** Return the length (number of elements) of the given list. *)
@since 4.08.0
*)
+val concat_map : f:('a -> 'b list) -> 'a list -> 'b list
+(** [List.concat_map f l] gives the same result as
+ {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive.
+
+ @since 4.10.0
+*)
+
val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a
(** [List.fold_left f a [b1; ...; bn]] is
[f (... (f (f a b1) b2) ...) bn]. *)
list [l].
@since 4.05 *)
+val find_map: f:('a -> 'b option) -> 'a list -> 'b option
+(** [find_map f l] applies [f] to the elements of [l] in order,
+ and returns the first result of the form [Some v], or [None]
+ if none exist.
+ @since 4.10.0
+*)
+
val filter : f:('a -> bool) -> 'a list -> 'a list
(** [filter p l] returns all the elements of the list [l]
that satisfy the predicate [p]. The order of the elements
let value o ~default = match o with Some v -> v | None -> default
let get = function Some v -> v | None -> invalid_arg "option is None"
let bind o f = match o with None -> None | Some v -> f v
-let join = function Some (Some _ as o) -> o | _ -> None
+let join = function Some o -> o | None -> None
let map f o = match o with None -> None | Some v -> Some (f v)
let fold ~none ~some = function Some v -> some v | None -> none
let iter f = function Some v -> f v | None -> ()
(** {1 Current call stack} *)
-val get_callstack: int -> raw_backtrace
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
(** [Printexc.get_callstack n] returns a description of the top of the
call stack on the current program point (for the current thread),
with at most [n] entries. (Note: this function is not related to
The types and their meanings are:
- [d], [i]: convert an integer argument to signed decimal.
+ The flag [#] adds underscores to large values for readability.
- [u], [n], [l], [L], or [N]: convert an integer argument to
unsigned decimal. Warning: [n], [l], [L], and [N] are
used for [scanf], and should not be used for [printf].
+ The flag [#] adds underscores to large values for readability.
- [x]: convert an integer argument to unsigned hexadecimal,
using lowercase letters.
+ The flag [#] adds a [0x] prefix to non zero values.
- [X]: convert an integer argument to unsigned hexadecimal,
using uppercase letters.
+ The flag [#] adds a [0X] prefix to non zero values.
- [o]: convert an integer argument to unsigned octal.
+ The flag [#] adds a [0] prefix to non zero values.
- [s]: insert a string argument.
- [S]: convert a string argument to OCaml syntax (double quotes, escapes).
- [c]: insert a character argument.
in the style [dddd.ddd].
- [F]: convert a floating-point argument to OCaml syntax ([dddd.]
or [dddd.ddd] or [d.ddd e+-dd]).
+ Converts to hexadecimal with the [#] flag (see [h]).
- [e] or [E]: convert a floating-point argument to decimal notation,
in the style [d.ddd e+-dd] (mantissa and exponent).
- [g] or [G]: convert a floating-point argument to decimal notation,
- space: for signed numerical conversions, prefix number with a
space if positive.
- [#]: request an alternate formatting style for the integer types
- ([x], [X], [o], [lx], [lX], [lo], [Lx], [LX], [Lo], [d], [i], [u],
- [ld], [li], [lu], [Ld], [Li], [Lu], [nd], [ni], [nu]).
+ and the floating-point type [F].
The optional [width] is an integer indicating the minimal
width of the result. For instance, [%6d] prints an integer,
let c = integer_conversion_of_char (char_of_iconv iconv) in
let scan width _ ib = scan_int_conversion c width ib in
pad_prec_scanf ib rest readers pad prec scan (token_int64 c)
- | Float ((_, Float_F), pad, prec, rest) ->
+ | Float ((_, (Float_F | Float_CF)), pad, prec, rest) ->
pad_prec_scanf ib rest readers pad prec scan_caml_float token_float
| Float ((_, (Float_f | Float_e | Float_E | Float_g | Float_G)),
pad, prec, rest) ->
exception Out_of_memory
(** Exception raised by the garbage collector when there is
- insufficient memory to complete the computation. *)
+ insufficient memory to complete the computation. (Not reliable for
+ allocations on the minor heap.) *)
exception Stack_overflow
(** Exception raised by the bytecode interpreter when the evaluation
stack reaches its maximal size. This often indicates infinite or
- excessively deep recursion in the user's program. (Not fully
- implemented by the native-code compiler.) *)
+ excessively deep recursion in the user's program.
+
+ Before 4.10, it was not fully implemented by the native-code
+ compiler. *)
exception Sys_error of string
[@ocaml.warn_on_literal_pattern]
(* *)
(**************************************************************************)
-(** String operations. *)
+(** String operations.
+ This module is intended to be used through {!StdLabels} which replaces
+ {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts
+
+ For example:
+ {[
+ open StdLabels
+
+ let to_upper = String.map ~f:Char.uppercase_ascii
+ ]} *)
external length : string -> int = "%string_length"
(** Return the length (number of characters) of the given string. *)
*)
external command : string -> int = "caml_sys_system_command"
-(** Execute the given shell command and return its exit code. *)
+(** Execute the given shell command and return its exit code.
+
+ The argument of {!Sys.command} is generally the name of a
+ command followed by zero, one or several arguments, separated
+ by whitespace. The given argument is interpreted by a
+ shell: either the Windows shell [cmd.exe] for the Win32 ports of
+ OCaml, or the POSIX shell [sh] for other ports. It can contain
+ shell builtin commands such as [echo], and also special characters
+ such as file redirections [>] and [<], which will be honored by the
+ shell.
+
+ Conversely, whitespace or special shell characters occuring in
+ command names or in their arguments must be quoted or escaped
+ so that the shell does not interpret them. The quoting rules vary
+ between the POSIX shell and the Windows shell.
+ The {!Filename.quote_command} performs the appropriate quoting
+ given a command name, a list of arguments, and optional file redirections.
+*)
external time : unit -> (float [@unboxed]) =
"caml_sys_time" "caml_sys_time_unboxed" [@@noalloc]
@since 4.03.0
*)
+
+module Immediate64 : sig
+ (** This module allows to define a type [t] with the [immediate64]
+ attribute. This attribute means that the type is immediate on 64
+ bit architectures. On other architectures, it might or might not
+ be immediate.
+
+ @since 4.10.0
+ *)
+
+ module type Non_immediate = sig
+ type t
+ end
+ module type Immediate = sig
+ type t [@@immediate]
+ end
+
+ module Make(Immediate : Immediate)(Non_immediate : Non_immediate) : sig
+ type t [@@immediate64]
+ type 'a repr =
+ | Immediate : Immediate.t repr
+ | Non_immediate : Non_immediate.t repr
+ val repr : t repr
+ end
+end
(* Optimization *)
external opaque_identity : 'a -> 'a = "%opaque"
+
+module Immediate64 = struct
+ module type Non_immediate = sig
+ type t
+ end
+ module type Immediate = sig
+ type t [@@immediate]
+ end
+
+ module Make(Immediate : Immediate)(Non_immediate : Non_immediate) = struct
+ type t [@@immediate64]
+ type 'a repr =
+ | Immediate : Immediate.t repr
+ | Non_immediate : Non_immediate.t repr
+ external magic : _ repr -> t repr = "%identity"
+ let repr =
+ if word_size = 64 then
+ magic Immediate
+ else
+ magic Non_immediate
+ end
+end
else # Non-cygwin Unix
find := find
endif
+ FLEXLINK_ENV =
else # Windows
find := /usr/bin/find
FLEXDLL_SUBMODULE_PRESENT := $(wildcard ../flexdll/Makefile)
default:
@echo "Available targets:"
@echo " all launch all tests"
- @echo " legacy launch legacy tests"
- @echo " new launch new (ocamltest based) tests"
@echo " all-foo launch all tests beginning with foo"
@echo " parallel launch all tests using GNU parallel"
@echo " parallel-foo launch all tests beginning with foo using \
.PHONY: all
all:
- @rm -f $(TESTLOG)
- @$(MAKE) $(NO_PRINT) legacy-without-report
- @$(MAKE) $(NO_PRINT) new-without-report
- @$(MAKE) $(NO_PRINT) report
-
-.PHONY: legacy
-legacy:
- @rm -f $(TESTLOG)
- @$(MAKE) $(NO_PRINT) legacy-without-report
- @$(MAKE) $(NO_PRINT) report
-
-.PHONY: legacy-without-report
-legacy-without-report: lib tools
- @for dir in tests/*; do \
- $(MAKE) $(NO_PRINT) exec-one DIR=$$dir LEGACY=y; \
- done 2>&1 | tee -a $(TESTLOG)
- @$(MAKE) $(NO_PRINT) retries
-
-.PHONY: new
-new:
@rm -f $(TESTLOG)
@$(MAKE) $(NO_PRINT) new-without-report
@$(MAKE) $(NO_PRINT) report
.PHONY: new-without-report
new-without-report: lib tools
@rm -f $(failstamp)
- @(for file in `$(find) tests -name ocamltests`; do \
- dir=`dirname $$file`; \
+ @(IFS=$$(printf "\r\n"); \
+ $(ocamltest) -find-test-dirs tests | while read dir; do \
echo Running tests from \'$$dir\' ... ; \
$(MAKE) exec-ocamltest DIR=$$dir \
OCAMLTESTENV="" OCAMLTESTFLAGS=""; \
.PHONY: exec-one
exec-one:
- @if [ ! -f $(DIR)/Makefile -a ! -f $(DIR)/ocamltests ]; then \
+ @if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \
+ echo "Running tests from '$$DIR' ..."; \
+ $(MAKE) exec-ocamltest DIR=$(DIR) \
+ OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \
+ OCAMLTESTFLAGS=""; \
+ else \
for dir in $(DIR)/*; do \
if [ -d $$dir ]; then \
$(MAKE) exec-one DIR=$$dir; \
fi; \
done; \
- elif [ -f $(DIR)/Makefile ]; then \
- echo "Running tests from '$$DIR' ..."; \
- cd $(DIR) && \
- $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) || echo '=> unexpected error'; \
- elif [ -f $(DIR)/ocamltests ] && [ -z $(LEGACY) ] ; then \
- echo "Running tests from '$$DIR' ..."; \
- $(MAKE) exec-ocamltest DIR=$(DIR) \
- OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \
- OCAMLTESTFLAGS=""; \
fi
.PHONY: exec-ocamltest
exec-ocamltest:
@if [ -z "$(DIR)" ]; then exit 1; fi
@if [ ! -d "$(DIR)" ]; then exit 1; fi
- @file=$(DIR)/ocamltests; \
- (IFS=$$(printf "\r\n"); while read testfile; do \
+ @(IFS=$$(printf "\r\n"); \
+ $(ocamltest) -list-tests $(DIR) | while read testfile; do \
TERM=dumb $(OCAMLTESTENV) \
$(ocamltest) $(OCAMLTESTFLAGS) $(DIR)/$$testfile || \
echo " ... testing '$$testfile' => unexpected error"; \
- done < $$file) || echo directory "$(DIR)" >>$(failstamp)
+ done) || echo directory "$(DIR)" >>$(failstamp)
.PHONY: clean-one
clean-one:
echo "Directory '$(DIR)' does not exist."; \
exit 1; \
fi
- @if [ -f $(DIR)/ocamltests ]; then \
+ @if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \
$(MAKE) exec-ocamltest DIR=$(DIR) \
OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \
OCAMLTESTFLAGS="-promote"; \
.PHONY: lib
lib:
- @cd lib && $(MAKE) -s BASEDIR=$(BASEDIR)
+ @$(MAKE) -s -C lib
.PHONY: tools
tools:
.PHONY: clean
clean:
- @cd lib && $(MAKE) BASEDIR=$(BASEDIR) clean
+ @$(MAKE) -C lib clean
@cd tools && $(MAKE) BASEDIR=$(BASEDIR) clean
- @for file in `$(FIND) interactive tests -name Makefile`; do \
- (cd `dirname $$file` && $(MAKE) BASEDIR=$(BASEDIR) clean); \
- done
$(FIND) . -name '*_ocamltest*' | xargs rm -rf
rm -f $(failstamp)
.PHONY: report
report:
@if [ ! -f $(TESTLOG) ]; then echo "No $(TESTLOG) file."; exit 1; fi
- @awk -f makefiles/summarize.awk < $(TESTLOG)
+ @awk -f summarize.awk < $(TESTLOG)
.PHONY: retry-list
retry-list:
.PHONY: retries
retries:
@awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) \
- -f makefiles/summarize.awk < $(TESTLOG) > _retries
+ -f summarize.awk < $(TESTLOG) > _retries
@test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list
@rm -f _retries
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Xavier Clerc, SED, INRIA Rocquencourt *
-#* *
-#* Copyright 2010 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-BASEDIR=../..
-
-default:
- @$(OCAMLC) -o program.byte alloc.ml
- @./program.byte
- @$(OCAMLOPT) -o program.native alloc.ml
- @./program.native
-
-clean: defaultclean
- @rm -fr program.*
-
-include $(BASEDIR)/makefiles/Makefile.common
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Damien Doligez, projet Para, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* Random allocation test *)
-
-(*
- Allocate arrays of strings, of random sizes in [0..1000[, and put them
- into an array of 32768. Replace a randomly-selected array with a new
- random-length array. Reiterate ad infinitum.
-*)
-
-let l = 32768;;
-let m = 1000;;
-
-let ar = Array.make l "";;
-
-Random.init 1234;;
-
-let compact_flag = ref false;;
-
-let main () =
- while true do
- for i = 1 to 100000 do
- ar.(Random.int l) <- String.create (Random.int m);
- done;
- if !compact_flag then Gc.compact () else Gc.full_major ();
- print_newline ();
- Gc.print_stat stdout;
- flush stdout;
- done
-;;
-
-let argspecs = [
- "-c", Arg.Set compact_flag, "do heap compactions";
-];;
-
-Arg.parse argspecs (fun _ -> ()) "Usage: alloc [-c]";;
-
-main ();;
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Xavier Clerc, SED, INRIA Rocquencourt *
-#* *
-#* Copyright 2010 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-BASEDIR=../..
-
-default:
- @$(OCAMLC) -o program.byte signals.ml
- @./program.byte
- @$(OCAMLOPT) -o program.native signals.ml
- @./program.native
-
-clean: defaultclean
- @rm -fr program.*
-
-include $(BASEDIR)/makefiles/Makefile.common
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1995 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-let rec tak (x, y, z) =
- if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
- else z
-
-let break_handler _ =
- print_string "Thank you for pressing ctrl-C."; print_newline();
- print_string "Allocating a bit..."; flush stdout;
- ignore (tak(18,12,6)); print_string "done."; print_newline()
-
-let stop_handler _ =
- print_string "Thank you for pressing ctrl-Z."; print_newline();
- print_string "Now raising an exception..."; print_newline();
- raise Exit
-
-let _ =
- ignore (Sys.signal Sys.sigint (Sys.Signal_handle break_handler));
- ignore (Sys.signal Sys.sigtstp (Sys.Signal_handle stop_handler));
- begin try
- print_string "Computing like crazy..."; print_newline();
- for i = 1 to 1000 do ignore (tak(18,12,6)) done;
- print_string "Reading on input..."; print_newline();
- for i = 1 to 5 do
- try
- let s = read_line () in
- print_string ">> "; print_string s; print_newline()
- with Exit ->
- print_string "Got Exit, continuing."; print_newline()
- done
- with Exit ->
- print_string "Got Exit, exiting."; print_newline()
- end;
- exit 0
#* *
#**************************************************************************
-.PHONY: compile
-compile: compile-targets
+TOPDIR = ../..
+COMPFLAGS ?=
+RUNTIME_VARIANT ?=
-.PHONY: promote
-promote: defaultpromote
+include $(TOPDIR)/Makefile.tools
-.PHONY: clean
-clean: defaultclean
+libraries := testing.cmi testing.cma lib.cmo
-include ../makefiles/Makefile.common
+# If the native compiler is enabled, then also compile testing.cmxa
+ifeq "$(NATIVE_COMPILER)" "true"
+libraries += testing.cmxa
+endif
-.PHONY: compile-targets
-compile-targets: testing.cmi testing.cma lib.cmo
- @if $(BYTECODE_ONLY); then : ; else \
- $(MAKE) testing.cmxa; \
- fi
+all: $(libraries)
testing.cma: testing.cmo
- $(OCAMLC) -a -linkall $(ADD_COMPFLAGS) -o $@ $<
+ $(OCAMLC) -a -linkall -o $@ $<
testing.cmxa: testing.cmx
- $(OCAMLOPT) -a -linkall $(ADD_COMPFLAGS) -o $@ $<
+ $(OCAMLOPT) -a -linkall -o $@ $<
+
+testing.cmo : testing.cmi
+
+%.cmi: %.mli
+ $(OCAMLC) -c $<
+
+%.cmo: %.ml
+ $(OCAMLC) -c $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) -c $<
+
+.PHONY: clean
+clean:
+ rm -f *.cm* *.$(O) *.$(A)
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Xavier Clerc, SED, INRIA Rocquencourt *
-#* *
-#* Copyright 2010 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-TOPDIR=$(BASEDIR)/..
-include $(TOPDIR)/Makefile.tools
-
-codegen := $(OTOPDIR)/testsuite/tools/codegen
-
-.PHONY: defaultpromote
-defaultpromote:
- @for file in *.reference; do \
- cp `basename $$file reference`result $$file; \
- done
-
-.PHONY: defaultclean
-defaultclean:
- @rm -f *.cmo *.cmi *.cmx *.cma *.cmxa *.cmxs *.$(O) *.$(SO) *.$(A) *.exe
- @rm -f *.exe.manifest
- @for dsym in *.dSYM; do \
- if [ -d $$dsym ]; then \
- rm -fr $$dsym; \
- fi \
- done
-
-.SUFFIXES:
-.SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .$(O) .so .c .f
-
-.mli.cmi:
- @$(OCAMLC) -c $(ADD_COMPFLAGS) $<
-
-.ml.cmi:
- @$(OCAMLC) -c $(ADD_COMPFLAGS) $<
-
-.ml.cmo:
- @if [ -f $<i ]; then $(OCAMLC) -c $(ADD_COMPFLAGS) $<i; fi
- @$(OCAMLC) -c $(ADD_COMPFLAGS) $<
-
-.ml.cmx:
- @$(OCAMLOPT) -c $(ADD_COMPFLAGS) $<
-
-.cmx.so:
- @$(OCAMLOPT) -o $@ -shared $(ADD_COMPFLAGS) $<
-
-.cmxa.so:
- @$(OCAMLOPT) -o $@ -shared -linkall $(ADD_COMPFLAGS) $<
-
-%.ml %.mli: %.mly
- @$(OCAMLYACC) -q $< 2> /dev/null
-
-.mll.ml:
- @$(OCAMLLEX) -q $< > /dev/null
-
-.cmm.s:
- @$(OCAMLRUN) $(codegen) -S $*.cmm
-
-.cmm.obj:
- @$(OCAMLRUN) $(codegen) $*.cmm > $*.s
- @set -o pipefail ; \
- $(ASM) $*.obj $*.s | tail -n +2
-
-.S.o:
- @$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $*.o $*.S
-
-.PRECIOUS: %.s
-.s.o:
- @$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -o $*.o $*.s
-
-.c.o:
- @$(CC) $(OC_CFLAGS) -c -I$(CTOPDIR)/runtime $*.c -o $*.$(O)
-
-.f.o:
- @$(FORTRAN_COMPILER) -c -I$(CTOPDIR)/runtime $*.f -o $*.$(O)
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Xavier Clerc, SED, INRIA Rocquencourt *
-#* *
-#* Copyright 2010 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-CMI_FILES=$(MODULES:=.cmi)
-CMO_FILES=$(MODULES:=.cmo)
-CMX_FILES=$(MODULES:=.cmx)
-CMA_FILES=$(LIBRARIES:=.cma)
-CMXA_FILES=$(LIBRARIES:=.cmxa)
-ML_LEX_FILES=$(LEX_MODULES:=.ml)
-ML_YACC_FILES=$(YACC_MODULES:=.ml)
-MLI_YACC_FILES=$(YACC_MODULES:=.mli)
-ML_FILES=$(ML_LEX_FILES) $(ML_YACC_FILES)
-O_FILES=$(C_FILES:=.$(O))
-ADD_CMO_FILES=$(ADD_MODULES:=.cmo)
-ADD_CMX_FILES=$(ADD_MODULES:=.cmx)
-
-GENERATED_SOURCES=$(ML_LEX_FILES) $(ML_YACC_FILES) $(MLI_YACC_FILES)
-
-CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi`
-ADD_CFLAGS+=$(CUSTOM_FLAG)
-MYRUNTIME=`if [ -z "$(C_FILES)$(CUSTOM)" ]; then echo '$(OCAMLRUN)'; fi`
-
-C_INCLUDES+=-I $(CTOPDIR)/runtime
-
-.PHONY: default
-default:
- @$(MAKE) compile
- @$(NATIVECODE_ONLY) && $(BYTECODE_ONLY) \
- && echo " ... testing => skipped" \
- || $(SET_LD_PATH) $(MAKE) run
-
-# See run-file in Makefile.several for the use of mktemp (included for
-# completeness; should be unnecessary)
-.PHONY: compile
-compile: $(ML_FILES)
- @for file in $(C_FILES); do \
- $(OCAMLC) -c $(C_INCLUDES) $$file.c; \
- done
- @if $(NATIVECODE_ONLY); then : ; else \
- test -e program.byte.exe && { \
- T="`mktemp -p .`"; \
- mv -f program.byte.exe "$$T"; \
- rm -f "$$T"; \
- } ; \
- rm -f program.byte program.byte.exe; \
- $(MAKE) $(CMO_FILES) $(MAIN_MODULE).cmo; \
- $(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o program.byte$(EXE) \
- $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \
- $(MAIN_MODULE).cmo; \
- fi
- @if $(BYTECODE_ONLY); then : ; else \
- test -e program.native.exe && { \
- T="`mktemp -p .`"; \
- mv -f program.native.exe "$$T"; \
- rm -f "$$T"; \
- } ; \
- rm -f program.native program.native.exe; \
- $(MAKE) $(CMX_FILES) $(MAIN_MODULE).cmx; \
- $(OCAMLOPT) $(ADD_COMPFLAGS) $(ADD_OPTCOMPFLAGS) \
- -o program.native$(EXE) $(O_FILES) \
- $(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) \
- $(MAIN_MODULE).cmx; \
- fi
-
-.PHONY: run
-run:
- @printf " ... testing with"
- @if $(NATIVECODE_ONLY); then : ; else \
- printf " ocamlc"; \
- FLAMBDA=$(FLAMBDA) $(MYRUNTIME) ./program.byte$(EXE) $(EXEC_ARGS) \
- >$(MAIN_MODULE).result \
- && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \
- >/dev/null; \
- fi \
- && if $(BYTECODE_ONLY); then : ; else \
- printf " ocamlopt"; \
- FLAMBDA=$(FLAMBDA) ./program.native$(EXE) $(EXEC_ARGS) \
- > $(MAIN_MODULE).result \
- && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \
- >/dev/null; \
- fi \
- && echo " => passed" || echo " => failed"
-
-
-.PHONY: promote
-promote: defaultpromote
-
-.PHONY: clean
-clean: defaultclean
- @rm -f *.result program.byte program.byte.exe \
- program.native program.native.exe \
- $(GENERATED_SOURCES) $(O_FILES) $(TEST_TEMP_FILES)
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, projet Gallium, INRIA Rocquencourt *
-#* *
-#* Copyright 2013 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-function check() {
- if (!in_test){
- printf("error at line %d: found test result without test start\n", NR);
- errored = 1;
- }
-}
-
-function clear() {
- curfile = "";
- in_test = 0;
-}
-
-function record_pass() {
- check();
- if (!(key in RESULTS)) ++nresults;
- RESULTS[key] = "p";
- delete SKIPPED[curdir];
- clear();
-}
-
-function record_skip() {
- check();
- if (!(key in RESULTS)) ++nresults;
- RESULTS[key] = "s";
- if (curdir in SKIPPED) SKIPPED[curdir] = 1;
- clear();
-}
-
-function record_na() {
- check();
- if (!(key in RESULTS)) ++nresults;
- RESULTS[key] = "n";
- if (curdir in SKIPPED) SKIPPED[curdir] = 1;
- clear();
-}
-
-# The output cares only if the test passes at least once so if a test passes,
-# but then fails in a re-run triggered by a different test, ignore it.
-function record_fail() {
- check();
- if (!(key in RESULTS) || RESULTS[key] == "s"){
- if (!(key in RESULTS)) ++nresults;
- RESULTS[key] = "f";
- }
- delete SKIPPED[curdir];
- clear();
-}
-
-function record_unexp() {
- if (!(key in RESULTS) || RESULTS[key] == "s"){
- if (!(key in RESULTS)) ++nresults;
- RESULTS[key] = "e";
- }
- delete SKIPPED[curdir];
- clear();
-}
-
-/Running tests from '[^']*'/ {
- if (in_test) record_unexp();
- match($0, /Running tests from '[^']*'/);
- curdir = substr($0, RSTART+20, RLENGTH - 21);
- # Use SKIPPED[curdir] as a sentinel to detect no output
- SKIPPED[curdir] = 0;
- key = curdir;
- DIRS[key] = key;
- curfile = "";
-}
-
-/ ... testing.* ... testing/ {
- printf("error at line %d: found two test results on the same line\n", NR);
- errored = 1;
-}
-
-/^ ... testing '[^']*'/ {
- if (in_test) record_unexp();
- match($0, /... testing '[^']*'/);
- curfile = substr($0, RSTART+13, RLENGTH-14);
- if (match($0, /... testing '[^']*' with [^:=]*/)){
- curfile = substr($0, RSTART+12, RLENGTH-12);
- }
- key = sprintf ("%s/%s", curdir, curfile);
- DIRS[key] = curdir;
- in_test = 1;
-}
-
-/^ ... testing (with|[^'])/ {
- if (in_test) record_unexp();
- key = curdir;
- DIRS[key] = curdir;
- in_test = 1;
-}
-
-/=> passed/ {
- record_pass();
-}
-
-/=> skipped/ {
- record_skip();
-}
-
-/=> n\/a/ {
- record_na();
-}
-
-/=> failed/ {
- record_fail();
-}
-
-/=> unexpected error/ {
- record_unexp();
-}
-
-/^re-ran / {
- if (in_test){
- printf("error at line %d: found re-ran inside a test\n", NR);
- errored = 1;
- }else{
- RERAN[substr($0, 8, length($0)-7)] += 1;
- ++ reran;
- }
-}
-
-END {
- if (errored){
- printf ("\n#### Some fatal error occurred during testing.\n\n");
- exit (3);
- }else{
- if (!retries){
- for (key in SKIPPED){
- if (!SKIPPED[key]){
- ++ empty;
- blanks[emptyidx++] = key;
- delete SKIPPED[key];
- }
- }
- for (key in RESULTS){
- r = RESULTS[key];
- if (r == "p"){
- ++ passed;
- }else if (r == "f"){
- ++ failed;
- fail[failidx++] = key;
- }else if (r == "e"){
- ++ unexped;
- unexp[unexpidx++] = key;
- }else if (r == "s"){
- ++ skipped;
- curdir = DIRS[key];
- if (curdir in SKIPPED){
- if (SKIPPED[curdir]){
- SKIPPED[curdir] = 0;
- skips[skipidx++] = curdir;
- }
- }else{
- skips[skipidx++] = key;
- }
- }else if (r == "n"){
- ++ ignored;
- }
- }
- printf("\n");
- if (skipped != 0){
- printf("\nList of skipped tests:\n");
- for (i=0; i < skipidx; i++) printf(" %s\n", skips[i]);
- }
- if (empty != 0){
- printf("\nList of directories returning no results:\n");
- for (i=0; i < empty; i++) printf(" %s\n", blanks[i]);
- }
- if (failed != 0){
- printf("\nList of failed tests:\n");
- for (i=0; i < failed; i++) printf(" %s\n", fail[i]);
- }
- if (unexped != 0){
- printf("\nList of unexpected errors:\n");
- for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]);
- }
- printf("\n");
- printf("Summary:\n");
- printf(" %3d tests passed\n", passed);
- printf(" %3d tests skipped\n", skipped);
- printf(" %3d tests failed\n", failed);
- printf(" %3d tests not started (parent test skipped or failed)\n",
- ignored);
- printf(" %3d unexpected errors\n", unexped);
- printf(" %3d tests considered", nresults);
- if (nresults != passed + skipped + ignored + failed + unexped){
- printf (" (totals don't add up??)");
- }
- printf ("\n");
- if (reran != 0){
- printf(" %3d test dir re-runs\n", reran);
- }
- if (failed || unexped){
- printf("#### Something failed. Exiting with error status.\n\n");
- exit 4;
- }
- }else{
- for (key in RESULTS){
- if (RESULTS[key] == "f" || RESULTS[key] == "e"){
- key = DIRS[key];
- if (!(key in RERUNS)){
- RERUNS[key] = 1;
- if (RERAN[key] < max_retries){
- printf("%s\n", key);
- }
- }
- }
- }
- }
- }
-}
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Damien Doligez, projet Gallium, INRIA Rocquencourt *
+#* *
+#* Copyright 2013 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+function check() {
+ if (!in_test){
+ printf("error at line %d: found test result without test start\n", NR);
+ errored = 1;
+ }
+}
+
+function clear() {
+ curfile = "";
+ in_test = 0;
+}
+
+function record_pass() {
+ check();
+ if (!(key in RESULTS)) ++nresults;
+ RESULTS[key] = "p";
+ delete SKIPPED[curdir];
+ clear();
+}
+
+function record_skip() {
+ check();
+ if (!(key in RESULTS)) ++nresults;
+ RESULTS[key] = "s";
+ if (curdir in SKIPPED) SKIPPED[curdir] = 1;
+ clear();
+}
+
+function record_na() {
+ check();
+ if (!(key in RESULTS)) ++nresults;
+ RESULTS[key] = "n";
+ if (curdir in SKIPPED) SKIPPED[curdir] = 1;
+ clear();
+}
+
+# The output cares only if the test passes at least once so if a test passes,
+# but then fails in a re-run triggered by a different test, ignore it.
+function record_fail() {
+ check();
+ if (!(key in RESULTS) || RESULTS[key] == "s"){
+ if (!(key in RESULTS)) ++nresults;
+ RESULTS[key] = "f";
+ }
+ delete SKIPPED[curdir];
+ clear();
+}
+
+function record_unexp() {
+ if (!(key in RESULTS) || RESULTS[key] == "s"){
+ if (!(key in RESULTS)) ++nresults;
+ RESULTS[key] = "e";
+ }
+ delete SKIPPED[curdir];
+ clear();
+}
+
+/Running tests from '[^']*'/ {
+ if (in_test) record_unexp();
+ match($0, /Running tests from '[^']*'/);
+ curdir = substr($0, RSTART+20, RLENGTH - 21);
+ # Use SKIPPED[curdir] as a sentinel to detect no output
+ SKIPPED[curdir] = 0;
+ key = curdir;
+ DIRS[key] = key;
+ curfile = "";
+}
+
+/ ... testing.* ... testing/ {
+ printf("error at line %d: found two test results on the same line\n", NR);
+ errored = 1;
+}
+
+/^ ... testing '[^']*'/ {
+ if (in_test) record_unexp();
+ match($0, /... testing '[^']*'/);
+ curfile = substr($0, RSTART+13, RLENGTH-14);
+ if (match($0, /... testing '[^']*' with [^:=]*/)){
+ curfile = substr($0, RSTART+12, RLENGTH-12);
+ }
+ key = sprintf ("%s/%s", curdir, curfile);
+ DIRS[key] = curdir;
+ in_test = 1;
+}
+
+/^ ... testing (with|[^'])/ {
+ if (in_test) record_unexp();
+ key = curdir;
+ DIRS[key] = curdir;
+ in_test = 1;
+}
+
+/=> passed/ {
+ record_pass();
+}
+
+/=> skipped/ {
+ record_skip();
+}
+
+/=> n\/a/ {
+ record_na();
+}
+
+/=> failed/ {
+ record_fail();
+}
+
+/=> unexpected error/ {
+ record_unexp();
+}
+
+/^re-ran / {
+ if (in_test){
+ printf("error at line %d: found re-ran inside a test\n", NR);
+ errored = 1;
+ }else{
+ RERAN[substr($0, 8, length($0)-7)] += 1;
+ ++ reran;
+ }
+}
+
+END {
+ if (errored){
+ printf ("\n#### Some fatal error occurred during testing.\n\n");
+ exit (3);
+ }else{
+ if (!retries){
+ for (key in SKIPPED){
+ if (!SKIPPED[key]){
+ ++ empty;
+ blanks[emptyidx++] = key;
+ delete SKIPPED[key];
+ }
+ }
+ for (key in RESULTS){
+ r = RESULTS[key];
+ if (r == "p"){
+ ++ passed;
+ }else if (r == "f"){
+ ++ failed;
+ fail[failidx++] = key;
+ }else if (r == "e"){
+ ++ unexped;
+ unexp[unexpidx++] = key;
+ }else if (r == "s"){
+ ++ skipped;
+ curdir = DIRS[key];
+ if (curdir in SKIPPED){
+ if (SKIPPED[curdir]){
+ SKIPPED[curdir] = 0;
+ skips[skipidx++] = curdir;
+ }
+ }else{
+ skips[skipidx++] = key;
+ }
+ }else if (r == "n"){
+ ++ ignored;
+ }
+ }
+ printf("\n");
+ if (skipped != 0){
+ printf("\nList of skipped tests:\n");
+ for (i=0; i < skipidx; i++) printf(" %s\n", skips[i]);
+ }
+ if (empty != 0){
+ printf("\nList of directories returning no results:\n");
+ for (i=0; i < empty; i++) printf(" %s\n", blanks[i]);
+ }
+ if (failed != 0){
+ printf("\nList of failed tests:\n");
+ for (i=0; i < failed; i++) printf(" %s\n", fail[i]);
+ }
+ if (unexped != 0){
+ printf("\nList of unexpected errors:\n");
+ for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]);
+ }
+ printf("\n");
+ printf("Summary:\n");
+ printf(" %3d tests passed\n", passed);
+ printf(" %3d tests skipped\n", skipped);
+ printf(" %3d tests failed\n", failed);
+ printf(" %3d tests not started (parent test skipped or failed)\n",
+ ignored);
+ printf(" %3d unexpected errors\n", unexped);
+ printf(" %3d tests considered", nresults);
+ if (nresults != passed + skipped + ignored + failed + unexped){
+ printf (" (totals don't add up??)");
+ }
+ printf ("\n");
+ if (reran != 0){
+ printf(" %3d test dir re-runs\n", reran);
+ }
+ if (failed || unexped){
+ printf("#### Something failed. Exiting with error status.\n\n");
+ exit 4;
+ }
+ }else{
+ for (key in RESULTS){
+ if (RESULTS[key] == "f" || RESULTS[key] == "e"){
+ key = DIRS[key];
+ if (!(key in RERUNS)){
+ RERUNS[key] = 1;
+ if (RERAN[key] < max_retries){
+ printf("%s\n", key);
+ }
+ }
+ }
+ }
+ }
+ }
+}
+++ /dev/null
-afltest.ml
+++ /dev/null
-exn_raise.ml
--- /dev/null
+(* TEST
+* function_sections
+flags = "-S -function-sections"
+** arch_arm
+*** native
+reference = "${test_source_directory}/func_sections.arm.reference"
+** arch_arm64
+*** native
+reference = "${test_source_directory}/func_sections.arm.reference"
+** arch_amd64
+*** native
+reference = "${test_source_directory}/func_sections.reference"
+** arch_i386
+*** native
+reference = "${test_source_directory}/func_sections.reference"
+*)
+
+(* We have a separate reference output for ARM because
+ it doesn't emit .text after jump tables. *)
+
+(* Test for anonymous functions which result in a mangled symbol *)
+let f4 list =
+ List.map (fun s -> String.length s) list
+
+let test1 () =
+ f4 ["a";"asfda";"afda"]
+
+(* Test for jump tables*)
+
+let g1 s = s^"*"
+let g2 s = "*"^s
+let g3 s = "*"^s^"*"
+
+let f5 = function
+ | 1 -> g1 "a"
+ | 2 -> g2 "b"
+ | 3 -> g3 "c"
+ | 4 -> g1 "d"
+ | 5 -> g2 "e"
+ | 6 -> g3 "f"
+ | _ -> "x"
+
+let test2 () =
+ let list = [f5 5;
+ f5 7;
+ f5 15;
+ f5 26]
+ in
+ ignore list
+
+let iter = 1_000
+
+let f0 x = x - 7;
+[@@inline never]
+
+let f1 x = x + iter
+[@@inline never]
+
+let f2 x = f1(x)
+[@@inline never]
+
+let f3 x = f2(x)*f0(x)
+[@@inline never]
+
+let test3 () =
+ f3 iter
+
+
+let () =
+ ignore (test1 ());
+ ignore (test2 ());
+ ignore (test3 ());
+ ()
--- /dev/null
+#!/bin/sh
+
+exec > "${output}" 2>&1
+
+# first, run the program to make sure it doesn't crash
+${program}
+
+# now check the assembly file produced during compilation
+asm=${test_build_directory}/func_sections.s
+grep ".section .text.caml.camlFunc_sections__" "$asm" | wc -l | tr -d ' ' | sed '/^$/d'
--- /dev/null
+(* TEST
+ * flambda
+ ** native
+*)
+
+type t = T of { pos : int }
+
+let[@inline always] find_pos i =
+ let i = ref i in
+ let pos = !i in
+ T {pos}
+
+let[@inline always] use_pos i =
+ let (T {pos}) = find_pos i in
+ pos * 2
+
+
+let f () =
+ let x0 = Gc.allocated_bytes () in
+ let x1 = Gc.allocated_bytes () in
+
+ let n : int = (Sys.opaque_identity use_pos) 10 in
+
+ let x2 = Gc.allocated_bytes () in
+ assert (n = 20);
+ assert(x1 -. x0 = x2 -. x1) (* check no allocation between x1 and x2 *)
+ [@@inline never]
+
+let () = f ()
+++ /dev/null
-bind_tuples.ml
-is_static_flambda.ml
-is_static.ml
-optargs.ml
-register_typing.ml
-register_typing_switch.ml
-staticalloc.ml
-static_float_array_flambda.ml
-static_float_array_flambda_opaque.ml
-unrolling_flambda2.ml
-unrolling_flambda.ml
--- /dev/null
+(* TEST
+flags = "-dlive"
+files = "main.c"
+arguments = "-DUNIT_INT -DFUN=catch_rec_deadhandler main.c"
+* asmgen
+** run
+*** check-program-output
+*)
+
+(function "catch_rec_deadhandler" ()
+ (let x
+ (catch
+ (exit one)
+ with (one) 1
+ and (two) (exit three)
+ and (three) 3)
+ x))
--- /dev/null
+ catch rec
+ exit(1)
+ with(1)
+ catch rec
+ exit(1)
+ with(1)
--- /dev/null
+#!/bin/sh
+
+exec > "${output}" 2>&1
+
+grep -E "catch |with\(|and\(|exit\(" "${compiler_output}"
+++ /dev/null
-arith.cmm
-catch-rec.cmm
-catch-try.cmm
-catch-float.cmm
-catch-multiple.cmm
-catch-try-float.cmm
-checkbound.cmm
-even-odd-spill.cmm
-even-odd-spill-float.cmm
-even-odd.cmm
-fib.cmm
-integr.cmm
-pgcd.cmm
-quicksort.cmm
-quicksort2.cmm
-soli.cmm
-tagged-fib.cmm
-tagged-integr.cmm
-tagged-quicksort.cmm
-tagged-tak.cmm
-tak.cmm
(while (< i j)
(catch
(while 1
- (if (>= i hi) exit [])
- (if (> (addraref a i) pivot) exit [])
+ (if (>= i hi) (exit n25) [])
+ (if (> (addraref a i) pivot) (exit n25) [])
(assign i (+ i 1)))
- with [])
+ with (n25) [])
(catch
(while 1
- (if (<= j lo) exit [])
- (if (< (addraref a j) pivot) exit [])
+ (if (<= j lo) (exit n35) [])
+ (if (< (addraref a j) pivot) (exit n35) [])
(assign j (- j 1)))
- with [])
+ with (n35) [])
(if (< i j)
(let temp (addraref a i)
(addraset a i (addraref a j))
(while (< i j)
(catch
(while 1
- (if (>= i hi) exit [])
- (if (> (app cmp (intaref a i) pivot int) 0) exit [])
+ (if (>= i hi) (exit n25) [])
+ (if (> (app cmp (intaref a i) pivot int) 0) (exit n25) [])
(assign i (+ i 1)))
- with [])
+ with (n25) [])
(catch
(while 1
- (if (<= j lo) exit [])
- (if (< (app cmp (intaref a j) pivot int) 0) exit [])
+ (if (<= j lo) (exit n35) [])
+ (if (< (app cmp (intaref a j) pivot int) 0) (exit n35) [])
(assign j (- j 1)))
- with [])
+ with (n35) [])
(if (< i j)
(let temp (intaref a i)
(intaset a i (intaref a j))
(while (< i j)
(catch
(while 1
- (if (>= i hi) exit [])
- (if (> (addraref a (>>s i 1)) pivot) exit [])
+ (if (>= i hi) (exit n25) [])
+ (if (> (addraref a (>>s i 1)) pivot) (exit n25) [])
(assign i (+ i 2)))
- with [])
+ with (n25) [])
(catch
(while 1
- (if (<= j lo) exit [])
- (if (< (addraref a (>>s j 1)) pivot) exit [])
+ (if (<= j lo) (exit n35) [])
+ (if (< (addraref a (>>s j 1)) pivot) (exit n35) [])
(assign j (- j 2)))
- with [])
+ with (n35) [])
(if (< i j)
(let temp (addraref a (>>s i 1))
(addraset a (>>s i 1) (addraref a (>>s j 1)))
Raised by primitive operation at file "backtrace2.ml", line 67, characters 14-22
test_Not_found
Uncaught exception Not_found
-Raised at file "hashtbl.ml", line 194, characters 19-28
+Raised at file "hashtbl.ml", line 537, characters 19-28
Called from file "backtrace2.ml", line 48, characters 9-42
Re-raised at file "backtrace2.ml", line 48, characters 67-70
Called from file "backtrace2.ml", line 67, characters 11-23
Re-raised at file "camlinternalLazy.ml", line 36, characters 10-11
Called from file "backtrace2.ml", line 67, characters 11-23
Uncaught exception Not_found
-Raised at file "hashtbl.ml", line 194, characters 19-28
+Raised at file "hashtbl.ml", line 537, characters 19-28
Called from file "backtrace2.ml", line 55, characters 8-41
Re-raised at file "camlinternalLazy.ml", line 35, characters 62-63
Called from file "camlinternalLazy.ml", line 31, characters 17-27
Raised by primitive operation at file "backtrace2.ml", line 67, characters 14-22
test_Not_found
Uncaught exception Not_found
-Raised at file "hashtbl.ml", line 194, characters 13-28
+Raised at file "hashtbl.ml", line 537, characters 13-28
Called from file "backtrace2.ml", line 48, characters 9-42
Re-raised at file "backtrace2.ml", line 48, characters 61-70
Called from file "backtrace2.ml", line 67, characters 11-23
Re-raised at file "camlinternalLazy.ml", line 36, characters 4-11
Called from file "backtrace2.ml", line 67, characters 11-23
Uncaught exception Not_found
-Raised at file "hashtbl.ml", line 194, characters 13-28
+Raised at file "hashtbl.ml", line 537, characters 13-28
Called from file "backtrace2.ml", line 55, characters 8-41
Re-raised at file "camlinternalLazy.ml", line 35, characters 56-63
Called from file "camlinternalLazy.ml", line 31, characters 17-27
let () = f3 ()
let () = Printf.printf "new thread:\n"
let () = Thread.join (Thread.create f3 ())
+
+let () =
+ Gc.finalise (fun _ -> f0 ()) [|1|];
+ Gc.full_major ();
+ ()
Called from file "callstack.ml", line 14, characters 27-32
Called from file "callstack.ml", line 15, characters 27-32
Called from file "thread.ml", line 39, characters 8-14
+Raised by primitive operation at file "callstack.ml", line 12, characters 38-66
+Called from file "callstack.ml", line 23, characters 2-18
+++ /dev/null
-backtrace.ml
-backtrace2.ml
-backtrace3.ml
-backtrace_deprecated.ml
-backtrace_or_exception.ml
-backtrace_slots.ml
-backtraces_and_finalizers.ml
-callstack.ml
-inline_test.ml
-inline_traversal_test.ml
-pr6920_why_at.ml
-pr6920_why_swallow.ml
-raw_backtrace.ml
+++ /dev/null
-tfloat_hex.ml
-tfloat_record.ml
-zero_sized_float_arrays.ml
-float_literals.ml
+++ /dev/null
-manyargs.ml
--- /dev/null
+(* TEST
+flags = "-c -nostdlib -nopervasives -dlambda -dno-unique-ids"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/anonymous.ocamlc.reference"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** no-flambda
+**** check-ocamlopt.byte-output
+compiler_reference = "${test_source_directory}/anonymous.ocamlopt.reference"
+*** flambda
+**** check-ocamlc.byte-output
+compiler_reference =
+ "${test_source_directory}/anonymous.ocamlopt.flambda.reference"
+*)
+
+module _ = struct
+ let x = 13, 37
+end
+
+module rec A : sig
+ type t = B.t
+end = A
+and _ : sig
+ type t = A.t
+ val x : int * int
+end = struct
+ type t = B.t
+ let x = 4, 2
+end
+and B : sig
+ type t
+end = struct
+ type t
+
+ let x = "foo", "bar"
+end
+
+module type S
+
+let f (module _ : S) = ()
--- /dev/null
+(setglobal Anonymous!
+ (seq (ignore (let (x = [0: 13 37]) (makeblock 0 x)))
+ (let
+ (A =
+ (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6]
+ [0: [0]])
+ B =
+ (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6]
+ [0: [0]]))
+ (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x)))
+ (apply (field 1 (global CamlinternalMod!)) [0: [0]] A
+ (module-defn(A) anonymous.ml(23):567-608 A))
+ (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
+ (module-defn(B) anonymous.ml(33):703-773
+ (let (x = [0: "foo" "bar"]) (makeblock 0))))
+ (let (f = (function param 0a)) (makeblock 0 A B f))))))
--- /dev/null
+(seq (ignore (let (x = [0: 13 37]) (makeblock 0 x)))
+ (let
+ (A =
+ (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6]
+ [0: [0]])
+ B =
+ (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6]
+ [0: [0]]))
+ (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x)))
+ (apply (field 1 (global CamlinternalMod!)) [0: [0]] A
+ (module-defn(A) anonymous.ml(23):567-608 A))
+ (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
+ (module-defn(B) anonymous.ml(33):703-773
+ (let (x = [0: "foo" "bar"]) (makeblock 0))))
+ (let (f = (function param 0a)) (makeblock 0 A B f)))))
--- /dev/null
+(seq (ignore (let (x = [0: 13 37]) (makeblock 0 x)))
+ (let
+ (A =
+ (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6]
+ [0: [0]])
+ B =
+ (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6]
+ [0: [0]]))
+ (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x)))
+ (apply (field 1 (global CamlinternalMod!)) [0: [0]] A A)
+ (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
+ (let (x = [0: "foo" "bar"]) (makeblock 0)))
+ (setfield_ptr(root-init) 0 (global Anonymous!) A)
+ (setfield_ptr(root-init) 1 (global Anonymous!) B)
+ (let (f = (function param 0a))
+ (setfield_ptr(root-init) 2 (global Anonymous!) f))
+ 0a)))
+++ /dev/null
-main.ml
-recursive_module_evaluation_errors.ml
+++ /dev/null
-bounds.ml
-div_by_zero.ml
-function_in_ref.ml
-if_in_if.ml
-morematch.ml
-opaque_prim.ml
-pr1271.ml
-pr2719.ml
-pr6216.ml
-record_evaluation_order.ml
-robustmatch.ml
-sequential_and_or.ml
-structural_constants.ml
-tbuffer.ml
-testrandom.ml
-top_level_patterns.ml
-tprintf.ml
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(AB, MAB, A)
+File "robustmatch.ml", lines 43-47, characters 4-21:
+43 | ....match t1, t2, x with
+44 | | AB, AB, A -> ()
+45 | | MAB, _, A -> ()
+46 | | _, AB, B -> ()
+47 | | _, MAB, B -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(AB, MAB, A)
File "robustmatch.ml", lines 54-56, characters 4-27:
54 | ....match r1, r2, a with
55 | | R1, _, 0 -> ()
+++ /dev/null
-usemultdef.ml
+++ /dev/null
-tlength.ml
+++ /dev/null
-arrays.ml
-bigints.ml
-boxedints.ml
-constprop.ml.c
-divint.ml
-equality.ml
-eval_order_1.ml
-eval_order_2.ml
-eval_order_3.ml
-eval_order_4.ml
-eval_order_6.ml
-float.ml
-float_physical_equality.ml
-includestruct.ml
-localexn.ml
-localfunction.ml
-maps.ml
-min_int.ml
-opt_variants.ml
-patmatch.ml
-patmatch_incoherence.ml
-pr7253.ml
-pr7533.ml
-pr7657.ml
-recvalues.ml
-sets.ml
-stringmatch.ml
-switch_opts.ml
-tailcalls.ml
-trigraph.ml
-unit_naming.ml
-zero_divided_by_n.ml
--- /dev/null
+(* TEST
+ flags = "-nostdlib -nopervasives -dlambda"
+ * expect
+ *)
+
+(******************************************************************************)
+
+(* Check that the extra split indeed happens when the last row is made of
+ "variables" only *)
+
+let last_is_anys = function
+ | true, false -> 1
+ | _, false -> 2
+ | _, _ -> 3
+;;
+[%%expect{|
+(let
+ (last_is_anys/10 =
+ (function param/12 : int
+ (catch
+ (if (field 0 param/12) (if (field 1 param/12) (exit 1) 1)
+ (if (field 1 param/12) (exit 1) 2))
+ with (1) 3)))
+ (apply (field 1 (global Toploop!)) "last_is_anys" last_is_anys/10))
+val last_is_anys : bool * bool -> int = <fun>
+|}]
+
+let last_is_vars = function
+ | true, false -> 1
+ | _, false -> 2
+ | _x, _y -> 3
+;;
+[%%expect{|
+(let
+ (last_is_vars/17 =
+ (function param/21 : int
+ (catch
+ (if (field 0 param/21) (if (field 1 param/21) (exit 3) 1)
+ (if (field 1 param/21) (exit 3) 2))
+ with (3) 3)))
+ (apply (field 1 (global Toploop!)) "last_is_vars" last_is_vars/17))
+val last_is_vars : bool * bool -> int = <fun>
+|}]
+
+(******************************************************************************)
+
+(* Check that the [| _, false, true -> 12] gets raised. *)
+
+type t = ..
+type t += A | B of unit | C of bool * int;;
+[%%expect{|
+0a
+type t = ..
+(let
+ (A/25 = (makeblock 248 "A" (caml_fresh_oo_id 0))
+ B/26 = (makeblock 248 "B" (caml_fresh_oo_id 0))
+ C/27 = (makeblock 248 "C" (caml_fresh_oo_id 0)))
+ (seq (apply (field 1 (global Toploop!)) "A/25" A/25)
+ (apply (field 1 (global Toploop!)) "B/26" B/26)
+ (apply (field 1 (global Toploop!)) "C/27" C/27)))
+type t += A | B of unit | C of bool * int
+|}]
+
+let f = function
+ | A, true, _ -> 1
+ | _, false, false -> 11
+ | B _, true, _ -> 2
+ | C _, true, _ -> 3
+ | _, false, true -> 12
+ | _ -> 4
+;;
+[%%expect{|
+(let
+ (C/27 = (apply (field 0 (global Toploop!)) "C/27")
+ B/26 = (apply (field 0 (global Toploop!)) "B/26")
+ A/25 = (apply (field 0 (global Toploop!)) "A/25")
+ f/28 =
+ (function param/30 : int
+ (let (*match*/31 =a (field 0 param/30))
+ (catch
+ (if (== *match*/31 A/25) (if (field 1 param/30) 1 (exit 8))
+ (exit 8))
+ with (8)
+ (if (field 1 param/30)
+ (if (== (field 0 *match*/31) B/26) 2
+ (if (== (field 0 *match*/31) C/27) 3 4))
+ (if (field 2 param/30) 12 11))))))
+ (apply (field 1 (global Toploop!)) "f" f/28))
+val f : t * bool * bool -> int = <fun>
+|}]
--- /dev/null
+(* TEST
+ modules = "alloc_async_stubs.c"
+*)
+
+external test : int ref -> unit = "stub"
+
+let f () =
+ let r = ref 42 in
+ Gc.finalise (fun s -> r := !s) (ref 17);
+ Printf.printf "OCaml, before: %d\n%!" !r;
+ test r;
+ Printf.printf "OCaml, after: %d\n%!" !r;
+ ignore (Sys.opaque_identity (ref 100));
+ Printf.printf "OCaml, after alloc: %d\n%!" !r;
+ ()
+
+let () = (f [@inlined never]) ()
--- /dev/null
+OCaml, before: 42
+C, before: 42
+C, after: 42
+OCaml, after: 42
+OCaml, after alloc: 17
--- /dev/null
+#include <stdio.h>
+#include <stdlib.h>
+#include "caml/alloc.h"
+#include "caml/memory.h"
+
+const char* strs[] = { "foo", "bar", 0 };
+value stub(value ref)
+{
+ CAMLparam1(ref);
+ CAMLlocal2(x, y);
+ int i; char* s; intnat coll_before;
+
+ printf("C, before: %d\n", Int_val(Field(ref, 0)));
+
+ /* First, do enough major allocations to do a full major collection cycle */
+ coll_before = Caml_state_field(stat_major_collections);
+ while (Caml_state_field(stat_major_collections) <= coll_before+1) {
+ caml_alloc(10000, 0);
+ }
+
+ /* Now, call lots of allocation functions */
+
+ /* Small allocations */
+ caml_alloc(10, 0);
+ x = caml_alloc_small(2, 0);
+ Field(x, 0) = Val_unit;
+ Field(x, 1) = Val_unit;
+ caml_alloc_tuple(3);
+ caml_alloc_float_array(10);
+ caml_alloc_string(42);
+ caml_alloc_initialized_string(10, "abcdeabcde");
+ caml_copy_string("asoidjfa");
+ caml_copy_string_array(strs);
+ caml_copy_double(42.0);
+ caml_copy_int32(100);
+ caml_copy_int64(100);
+ caml_alloc_array(caml_copy_string, strs);
+ caml_alloc_sprintf("[%d]", 42);
+
+ /* Large allocations */
+ caml_alloc(1000, 0);
+ caml_alloc_shr(1000, 0);
+ caml_alloc_tuple(1000);
+ caml_alloc_float_array(1000);
+ caml_alloc_string(10000);
+ s = calloc(10000, 1);
+ caml_alloc_initialized_string(10000, s);
+ free(s);
+
+
+ printf("C, after: %d\n", Int_val(Field(ref, 0)));
+ fflush(stdout);
+ CAMLreturn (Val_unit);
+}
+++ /dev/null
-tcallback.ml
--- /dev/null
+(* TEST
+ include unix
+ * libunix
+ ** bytecode
+ ** native
+*)
+
+let pid = Unix.getpid ()
+
+let do_test () =
+ let seen_states = Array.make 5 (-1) in
+ let pos = ref 0 in
+ let sighandler signo =
+ (* These two instructions are duplicated everywhere, but we cannot
+ encapsulate them in a function, because function calls check
+ for signals in bytecode mode. *)
+ seen_states.(!pos) <- 3; pos := !pos + 1;
+ in
+ seen_states.(!pos) <- 0; pos := !pos + 1;
+ Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
+ seen_states.(!pos) <- 1; pos := !pos + 1;
+ Unix.kill pid Sys.sigusr1;
+ seen_states.(!pos) <- 2; pos := !pos + 1;
+ let _ = Sys.opaque_identity (ref 1) in
+ seen_states.(!pos) <- 4; pos := !pos + 1;
+ Sys.set_signal Sys.sigusr1 Sys.Signal_default;
+ assert (seen_states = [|0;1;2;3;4|])
+
+let () =
+ for _ = 0 to 10 do do_test () done;
+ Printf.printf "OK\n"
--- /dev/null
+(* TEST
+modules = "stub.c"
+* pass
+** bytecode
+** native
+* pass
+flags = "-ccopt -DCAML_NAME_SPACE"
+** bytecode
+** native
+*)
+
+external retrieve_young_limit : 'a -> nativeint = "retrieve_young_limit"
+
+let bar =
+ let foo = Bytes.create 4 in
+ retrieve_young_limit foo
--- /dev/null
+v is young
--- /dev/null
+#include <caml/minor_gc.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/address_class.h>
+/* see PR#8892 */
+typedef char * addr;
+
+CAMLprim value retrieve_young_limit(value v)
+{
+ CAMLparam1(v);
+ printf("v is%s young\n", (Is_young(v) ? "" : " not"));
+#ifdef CAML_NAME_SPACE
+ CAMLreturn(caml_copy_nativeint((intnat)caml_young_limit));
+#else
+ CAMLreturn(copy_nativeint((intnat)young_limit));
+#endif
+}
+++ /dev/null
-test_longident.ml
+++ /dev/null
-approx_meet.ml
-gpr998.ml
-specialise.ml
-gpr2239.ml
+++ /dev/null
-float_subst_boxed_number.ml
-unbox_under_assign.ml
+++ /dev/null
-deprecated_unsigned_printers.ml
-ignored_scan_counters.ml
-legacy_incompatible_flags.ml
-legacy_unfinished_modifiers.ml
+++ /dev/null
-margins.ml
-errors_batch.ml
+++ /dev/null
-functors.ml
+++ /dev/null
-globroots.ml
3 | open M(struct end)
^^^^^^^^^^^^^
Error: This module is not a structure; it has type
- functor (X : sig end) -> sig end
+ functor (X : sig end) -> sig end
|}]
open struct
Line 1, characters 15-41:
1 | include struct open struct type t = T end let x = T end
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The type t/143 introduced by this open appears in the signature
+Error: The type t/149 introduced by this open appears in the signature
Line 1, characters 46-47:
- The value x has no valid type if t/143 is hidden
+ The value x has no valid type if t/149 is hidden
|}];;
module A = struct
4 | type t = T
5 | let x = T
6 | end
-Error: The type t/149 introduced by this open appears in the signature
+Error: The type t/154 introduced by this open appears in the signature
Line 7, characters 8-9:
- The value y has no valid type if t/149 is hidden
+ The value y has no valid type if t/154 is hidden
|}];;
module A = struct
3 | ....open struct
4 | type t = T
5 | end
-Error: The type t/155 introduced by this open appears in the signature
+Error: The type t/159 introduced by this open appears in the signature
Line 6, characters 8-9:
- The value y has no valid type if t/155 is hidden
+ The value y has no valid type if t/159 is hidden
|}]
(* It was decided to not allow this anymore. *)
assert(y = 1)
end
[%%expect{|
-module N : sig end
+module N : sig end
|}]
module M = struct
end
end
[%%expect{|
-module M : sig end
+module M : sig end
|}]
(* It was decided to not allow this anymore *)
1 | let f () = let open functor(X: sig end) -> struct end in ();;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This module is not a structure; it has type
- functor (X : sig end) -> sig end
+ functor (X : sig end) -> sig end
|}]
+++ /dev/null
-accepted_batch.ml
-accepted_expect.ml
-clambda_optim.ml
-expansiveness.ml
-funct_body.ml
-gpr1506.ml
-shadowing.ml
module Let_unbound = struct
end;;
[%%expect{|
-module Let_unbound : sig end
+module Let_unbound : sig end
|}];;
let let_unbound =
+++ /dev/null
-let_syntax.ml
Error: This kind of expression is not allowed as right-hand side of `let rec'
|}];;
+let rec x = let module _ = struct let _ = x () end in fun () -> ();;
+[%%expect{|
+Line 1, characters 12-66:
+1 | let rec x = let module _ = struct let _ = x () end in fun () -> ();;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
let rec x = let module M = struct let f = x () let g = x end in fun () -> ();;
[%%expect{|
Line 1, characters 12-76:
and y = let module M = struct let x = x end in (module M : T)
;;
[%%expect{|
-module type T = sig end
+module type T = sig end
Line 2, characters 12-36:
2 | let rec x = (module (val y : T) : T)
^^^^^^^^^^^^^^^^^^^^^^^^
+++ /dev/null
-basic.ml
-extension_constructor.ml
-flat_float_array.ml
-no_flat_float_array.ml
-float_unboxing.ml
-records.ml
-labels.ml
-lazy_.ml
-modules.ml
-objects.ml
-pr7215.ml
-pr7231.ml
-pr7706.ml
-unboxed.ml
+++ /dev/null
-backreferences.ml
-class_1.ml
-class_2.ml
-evaluation_order_1.ml
-evaluation_order_2.ml
-evaluation_order_3.ml
-float_block_1.ml
-generic_array.ml
-labels.ml
-lazy_.ml
-lists.ml
-mixing_value_closures_1.ml
-mixing_value_closures_2.ml
-mutual_functions.ml
-nested.ml
-pr4989.ml
-pr8681.ml
-record_with.ml
-ref.ml
--- /dev/null
+(* TEST
+ * toplevel
+*)
+
+(* "*)" *)
+
+(* {|*)|} *)
+
+(* '"' *)
+
+(* f' '"' *)
+++ /dev/null
-escape.ml
-uchar_esc.ml
+++ /dev/null
-testarg.ml
-testerror.ml
(* TEST
+ compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
*)
let current = ref 0;;
--- /dev/null
+(* TEST
+ * expect
+*)
+
+let a = Array.make 8 None;;
+let _ = Array.fill a 2 3 (Some 42);;
+a;;
+[%%expect{|
+val a : '_weak1 option array =
+ [|None; None; None; None; None; None; None; None|]
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 42; Some 42; None; None; None|]
+|}]
+let _ = Array.fill a 3 1 (Some 0);;
+a;;
+[%%expect{|
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 0; Some 42; None; None; None|]
+|}]
+let _ = Array.fill a 3 6 None;;
+a;;
+[%%expect{|
+Exception: Invalid_argument "Array.fill".
+|}]
+let _ = Array.fill a (-1) 2 None;;
+a;;
+[%%expect{|
+Exception: Invalid_argument "Array.fill".
+|}]
+let _ = Gc.compact ();;
+let _ = Array.fill a 5 1 (Some (if Random.int 2 < 0 then 1 else 2));;
+a;;
+[%%expect{|
+- : unit = ()
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 0; Some 42; Some 2; None; None|]
+|}]
+let _ = Array.fill a 5 1 None;;
+a;;
+[%%expect{|
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 0; Some 42; None; None; None|]
+|}]
+
+
+let a = Array.make 8 0.;;
+let _ = Array.fill a 2 3 42.;;
+a;;
+[%%expect{|
+val a : float array = [|0.; 0.; 0.; 0.; 0.; 0.; 0.; 0.|]
+- : unit = ()
+- : float array = [|0.; 0.; 42.; 42.; 42.; 0.; 0.; 0.|]
+|}]
+++ /dev/null
-bigarrfml.ml
+++ /dev/null
-mapfile.ml
(* TEST
+ compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
*)
(** Test the various change_layout for Genarray and the various Array[n] *)
+++ /dev/null
-bigarrays.ml
-change_layout.ml
-fftba.ml
-pr5115.ml
-weak_bigarray.ml
+++ /dev/null
-binary.ml
-test_bytes.ml
+++ /dev/null
-test1_main.ml
-test2_main.ml
-test3_main.ml
-test4_main.ml
-test5_main.ml
-test6_main.ml
-test7_main.ml
-test8_main.ml
-test9_main.ml
files = "abstract.mli abstract.ml static.ml client.ml main.ml"
-set sub = "${test_source_directory}/sub"
+set src_sub = "${test_source_directory}/sub"
libraries = ""
*** script
script = "mkdir sub"
**** script
-script = "cp ${sub}/abstract.mli ${sub}/abstract.ml sub"
+script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub"
***** cd
-cwd = "${sub}"
+cwd = "sub"
****** ocamlc.byte
module = "abstract.mli"
******* ocamlc.byte
**** script
script = "mkdir sub"
***** script
-script = "cp ${sub}/abstract.mli ${sub}/abstract.ml sub"
+script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub"
****** cd
-cwd = "${sub}"
+cwd = "sub"
******* ocamlopt.byte
module = "abstract.mli"
******** ocamlopt.byte
module = ""
all_modules = "client.ml"
************* ocamlopt.byte
-module = "main_native.ml"
+module = "main.ml"
************** ocamlopt.byte
program = "${test_build_directory}/main_native"
libraries = "dynlink"
module = ""
-all_modules = "abstract.cmx static.cmx main_native.cmx"
+all_modules = "abstract.cmx static.cmx main.cmx"
*************** run
exit_status = "2"
**************** check-program-output
(* PR#4229 *)
let () =
+ let suffix =
+ match Sys.backend_type with
+ | Native -> "cmxs"
+ | Bytecode -> "cmo"
+ | Other _ -> assert false
+ in
try
(* Dynlink.init (); *) (* this function has been removed from the API *)
- Dynlink.loadfile "client.cmo"; (* utilise abstract.cmo *)
- Dynlink.loadfile "sub/abstract.cmo";
- Dynlink.loadfile "client.cmo" (* utilise sub/abstract.cmo *)
+ Dynlink.loadfile ("client."^suffix); (* utilise abstract.suffix *)
+ Dynlink.loadfile ("sub/abstract."^suffix);
+ Dynlink.loadfile ("client."^suffix) (* utilise sub/abstract.suffix *)
with
| Dynlink.Error (Dynlink.Module_already_loaded "Abstract") -> exit 2
-Abstract 10
\ No newline at end of file
+Abstract 10
+++ /dev/null
-(* PR#4229 *)
-
-let () =
- try
- (* Dynlink.init (); *) (* this function has been removed from the API *)
- Dynlink.loadfile "client.cmxs"; (* utilise abstract.cmx *)
- Dynlink.loadfile "sub/abstract.cmxs";
- Dynlink.loadfile "client.cmxs" (* utilise sub/abstract.cmx *)
- with
- | Dynlink.Error (Dynlink.Module_already_loaded "Abstract") -> exit 2
--- /dev/null
+(* TEST
+
+include dynlink
+files = "lib.ml lib2.ml test.c"
+ld_library_path += "${test_build_directory}"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+compile_only = "true"
+all_modules = "lib.ml lib2.ml test.c dyn.ml"
+**** ocamlmklib
+program = "lib"
+modules = "lib.cmo test.${objext}"
+compile_only = "false"
+***** ocamlc.byte
+program = "lib2.cma"
+libraries = ""
+all_modules = "lib2.cmo"
+compile_only = "false"
+flags = "-a"
+****** ocamlc.byte
+libraries += "dynlink"
+program = "${test_build_directory}/main.exe"
+all_modules = "dyn.cmo"
+flags = ""
+******* run
+output = "main.output"
+******** check-program-output
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+compile_only = "true"
+all_modules = "lib.ml lib2.ml test.c dyn.ml"
+***** ocamlmklib
+program = "test"
+modules = "test.${objext}"
+compile_only = "false"
+****** ocamlopt.byte
+program = "lib.cmxs"
+libraries = ""
+flags = "-shared -cclib -L. -cclib -ltest"
+all_modules = "lib.cmx"
+compile_only = "false"
+******* ocamlopt.byte
+program = "lib2.cmxs"
+all_modules = "lib2.cmx"
+compile_only = "false"
+flags = "-shared"
+******** ocamlopt.byte
+libraries += "dynlink"
+program = "${test_build_directory}/main.exe"
+all_modules = "dyn.cmx"
+flags = ""
+********* run
+output = "main.output"
+********** check-program-output
+*)
+let () =
+ Dynlink.allow_unsafe_modules true;
+ Dynlink.adapt_filename "lib.cma" |> Dynlink.loadfile;
+ Dynlink.adapt_filename "lib2.cma" |> Dynlink.loadfile
--- /dev/null
+external test : unit -> unit = "testdynfail"
--- /dev/null
+let test = Lib.test
--- /dev/null
+int testdynfail() {
+ return 0;
+}
--- /dev/null
+open Printf
+
+let () =
+ let argc = Array.length Sys.argv in
+ let out = ref stdout in
+ if argc > 1 then begin
+ for i = 1 to argc - 1 do
+ match Sys.argv.(i) with
+ | "-err" -> flush !out; out := stderr
+ | "-out" -> flush !out; out := stdout
+ | arg -> fprintf !out "argv[%d] = {|%s|}\n" i arg
+ done
+ end else begin
+ try
+ while true do
+ let l = input_line stdin in
+ printf "%s\n" l
+ done
+ with End_of_file -> ()
+ end
--- /dev/null
+(* TEST
+*)
+
+let () =
+ let ic = open_in Filename.null in
+ match input_char ic with
+ | exception End_of_file -> close_in ic
+ | _ -> assert false
+++ /dev/null
-extension.ml
-suffix.ml
--- /dev/null
+(* TEST
+
+files = "myecho.ml"
+
+* setup-ocamlc.byte-build-env
+program = "${test_build_directory}/quotecommand.byte"
+** ocamlc.byte
+program = "${test_build_directory}/myecho.exe"
+all_modules = "myecho.ml"
+*** ocamlc.byte
+program = "${test_build_directory}/quotecommand.byte"
+all_modules= "quotecommand.ml"
+**** check-ocamlc.byte-output
+***** run
+****** check-program-output
+
+* setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/quotecommand.opt"
+** ocamlopt.byte
+program = "${test_build_directory}/myecho.exe"
+all_modules = "myecho.ml"
+*** ocamlopt.byte
+include unix
+program = "${test_build_directory}/quotecommand.opt"
+all_modules= "quotecommand.ml"
+**** check-ocamlopt.byte-output
+***** run
+****** check-program-output
+
+*)
+
+open Printf
+
+let copy_channels ic oc =
+ let sz = 1024 in
+ let buf = Bytes.create sz in
+ let rec copy () =
+ let n = input ic buf 0 sz in
+ if n > 0 then (output oc buf 0 n; copy()) in
+ copy()
+
+let copy_file src dst =
+ let ic = open_in_bin src in
+ let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary]
+ 0o777 dst in
+ copy_channels ic oc;
+ close_in ic;
+ close_out oc
+
+let cat_file f =
+ let ic = open_in f in
+ copy_channels ic stdout;
+ close_in ic
+
+let myecho =
+ Filename.concat Filename.current_dir_name "my echo.exe"
+
+let run ?stdin ?stdout ?stderr args =
+ flush Stdlib.stdout;
+ let rc =
+ Sys.command (Filename.quote_command myecho ?stdin ?stdout ?stderr args) in
+ if rc > 0 then begin
+ printf "!!! my echo failed\n";
+ exit 2
+ end
+
+let _ =
+ copy_file "myecho.exe" "my echo.exe";
+ printf "-------- Spaces\n";
+ run ["Lorem ipsum dolor"; "sit amet,"; "consectetur adipiscing elit,"];
+ printf "-------- All ASCII characters\n";
+ run ["!\"#$%&'()*+,-./";
+ "0123456789";
+ ":;<=>?@";
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+ "[\\]^_`";
+ "abcdefghijklmnopqrstuvwxyz";
+ "{~|~}"
+ ];
+ printf "-------- Output redirection\n";
+ run ~stdout:"my 'file'.tmp" ["sed do eiusmod tempor incididunt";
+ "ut labore et dolore magna aliqua."];
+ printf "-------- Input redirection\n";
+ run ~stdin:"my 'file'.tmp" [];
+ Sys.remove "my 'file'.tmp";
+ printf "-------- Error redirection\n";
+ run ~stderr:"my 'file'.tmp"
+ ["Exceptur sint"; "-err"; "occaecat"; "cupidatat";
+ "-out"; "non proident"; "-err"; "sunt in culpa"];
+ printf "-- stderr:\n";
+ cat_file "my 'file'.tmp";
+ Sys.remove "my 'file'.tmp";
+ printf "-------- Output and error redirections (different files)\n";
+ run ~stdout:"my stdout.tmp" ~stderr:"my stderr.tmp"
+ ["qui officia"; "-err"; "deserunt"; "mollit";
+ "-out"; "anim id est"; "-err"; "laborum."];
+ printf "-- stdout:\n"; cat_file "my stdout.tmp"; Sys.remove "my stdout.tmp";
+ printf "-- stderr:\n"; cat_file "my stderr.tmp"; Sys.remove "my stderr.tmp";
+ printf "-------- Output and error redirections (same file)\n";
+ run ~stdout:"my file.tmp" ~stderr:"my file.tmp"
+ ["Duis aute"; "irure dolor"; "-err"; "in reprehenderit";
+ "in voluptate"; "-out"; "velit esse cillum"; "-err"; "dolore"];
+ cat_file "my file.tmp"; Sys.remove "my file.tmp";
+ Sys.remove "my echo.exe"
--- /dev/null
+-------- Spaces
+argv[1] = {|Lorem ipsum dolor|}
+argv[2] = {|sit amet,|}
+argv[3] = {|consectetur adipiscing elit,|}
+-------- All ASCII characters
+argv[1] = {|!"#$%&'()*+,-./|}
+argv[2] = {|0123456789|}
+argv[3] = {|:;<=>?@|}
+argv[4] = {|ABCDEFGHIJKLMNOPQRSTUVWXYZ|}
+argv[5] = {|[\]^_`|}
+argv[6] = {|abcdefghijklmnopqrstuvwxyz|}
+argv[7] = {|{~|~}|}
+-------- Output redirection
+-------- Input redirection
+argv[1] = {|sed do eiusmod tempor incididunt|}
+argv[2] = {|ut labore et dolore magna aliqua.|}
+-------- Error redirection
+argv[1] = {|Exceptur sint|}
+argv[6] = {|non proident|}
+-- stderr:
+argv[3] = {|occaecat|}
+argv[4] = {|cupidatat|}
+argv[8] = {|sunt in culpa|}
+-------- Output and error redirections (different files)
+-- stdout:
+argv[1] = {|qui officia|}
+argv[6] = {|anim id est|}
+-- stderr:
+argv[3] = {|deserunt|}
+argv[4] = {|mollit|}
+argv[8] = {|laborum.|}
+-------- Output and error redirections (same file)
+argv[1] = {|Duis aute|}
+argv[2] = {|irure dolor|}
+argv[4] = {|in reprehenderit|}
+argv[5] = {|in voluptate|}
+argv[7] = {|velit esse cillum|}
+argv[9] = {|dolore|}
+++ /dev/null
-floatarray.ml
+++ /dev/null
-pr6824.ml
-tformat.ml
-print_if_newline.ml
-pp_print_custom_break.ml
+++ /dev/null
-hfun.ml
-htbl.ml
--- /dev/null
+(* TEST
+ * expect
+*)
+
+let inspect (format : _ format6) =
+ let (CamlinternalFormatBasics.Format (fmt, str)) = format in
+ (CamlinternalFormat.string_of_fmt fmt, str);;
+[%%expect{|
+val inspect : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string * string = <fun>
+|}];;
+
+inspect "@[foo@]";;
+[%%expect{|
+- : string * string = ("@[foo@]", "@[foo@]")
+|}];;
+
+inspect "@%%";;
+[%%expect{|
+- : string * string = ("@%%", "@%%")
+|}];;
+
+inspect "@<";;
+[%%expect{|
+- : string * string = ("@<", "@<")
+|}];;
+
+inspect "@[<%s>@]";;
+[%%expect{|
+- : string * string = ("@[<%s>@]", "@[<%s>@]")
+|}];;
assert (not (List.exists (fun a -> a > 9) l));
assert (List.exists (fun _ -> true) l);
+ begin
+ let f ~limit a = if a >= limit then Some (a, limit) else None in
+ assert (List.find_map (f ~limit:3) [] = None);
+ assert (List.find_map (f ~limit:3) l = Some (3, 3));
+ assert (List.find_map (f ~limit:30) l = None);
+ end;
+
assert (List.compare_lengths [] [] = 0);
assert (List.compare_lengths [1;2] ['a';'b'] = 0);
assert (List.compare_lengths [] [1;2] < 0);
assert (List.compare_length_with ['1'] 1 = 0);
assert (List.compare_length_with ['1'] 2 < 0);
assert (List.filter_map string_of_even_opt l = ["0";"2";"4";"6";"8"]);
+ assert (List.concat_map (fun i -> [i; i+1]) [1; 5] = [1; 2; 5; 6]);
+ assert (
+ let count = ref 0 in
+ List.concat_map (fun i -> incr count; [i; !count]) [1; 5] = [1; 1; 5; 2]);
()
;;
--- /dev/null
+(* TEST *)
+
+let t : int array = Array.make 200 42
+let c = open_out_bin "data42"
+let () = Marshal.to_channel c t []
+let () = close_out c
+
+let t : int array = Array.make 200 0
+let c = open_out_bin "data0"
+let () = Marshal.to_channel c t []
+let () = close_out c
+
+let rec fill_minor accu = function
+ | 0 -> accu
+ | n -> fill_minor (n::accu) (n-1)
+
+let () =
+ let c0 = open_in_bin "data0" in
+ let c42 = open_in_bin "data42" in
+
+ ignore (Gc.create_alarm (fun () ->
+ seek_in c0 0;
+ ignore (Marshal.from_channel c0)));
+
+ for i = 0 to 100000 do
+ seek_in c42 0;
+ let res : int array = Marshal.from_channel c42 in
+ Array.iter (fun n -> assert (n = 42)) res
+ done;
+ Printf.printf "OK!\n"
+++ /dev/null
-reachable_words.ml
-with_tag.ml
+++ /dev/null
-pr6534.ml
-pr6938.ml
-tprintf.ml
test (sprintf "%12.3F" 42.42e42 =* " 4.24e+43");
test (sprintf "%.3F" 42.00 = "42.");
test (sprintf "%.3F" 0.0042 = "0.0042");
+ test (sprintf "%F" nan = "nan");
+ test (sprintf "%F" (-. nan) = "nan");
+ test (sprintf "%F" infinity = "infinity");
+ test (sprintf "%F" neg_infinity = "neg_infinity");
+
+ printf "\n#F\n%!";
+ test (sprintf "%+#F" (+0.) = "+0x0p+0");
+ test (sprintf "%+#F" (-0.) = "-0x0p+0");
+ test (sprintf "%+#F" (+1.) = "+0x1p+0");
+ test (sprintf "%+#F" (-1.) = "-0x1p+0");
+ test (sprintf "%+#F" (+1024.) = "+0x1p+10");
+ test (sprintf "% #F" (+1024.) = " 0x1p+10");
+ test (sprintf "%+#F" (-1024.) = "-0x1p+10");
+ test (sprintf "%#F" 0x123.456 = "0x1.23456p+8");
+ test (sprintf "%#F" 0x123456789ABCDE. = "0x1.23456789abcdep+52");
+ test (sprintf "%#F" epsilon_float = "0x1p-52");
+ test (sprintf "%#F" nan = "nan");
+ test (sprintf "%#F" (-. nan) = "nan");
+ test (sprintf "%#F" infinity = "infinity");
+ test (sprintf "%#F" neg_infinity = "neg_infinity");
printf "\nh\n%!";
test (sprintf "%+h" (+0.) = "+0x0p+0");
f
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
F
- 107 108 109 110 111 112 113 114 115 116 117 118
+ 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
+#F
+ 123 124 125 126 127 128 129 130 131 132 133 134 135 136
h
- 119 120 121 122 123 124 125 126 127 128 129 130 131
+ 137 138 139 140 141 142 143 144 145 146 147 148 149
H
- 132 133 134 135 136 137 138 139 140 141 142 143 144
+ 150 151 152 153 154 155 156 157 158 159 160 161 162
e
- 145 146 147 148 149 150 151 152 153 154 155 156 157 158
+ 163 164 165 166 167 168 169 170 171 172 173 174 175 176
E
- 159 160 161 162 163 164 165 166 167 168 169 170 171 172
+ 177 178 179 180 181 182 183 184 185 186 187 188 189 190
g
- 173 174 175 176 177 178 179 180 181
+ 191 192 193 194 195 196 197 198 199
G
- 182 183 184 185 186 187 188 189 190
+ 200 201 202 203 204 205 206 207 208
B
- 191 192 193 194
+ 209 210 211 212
ld/li positive
- 195 196 197 198 199 200 201
+ 213 214 215 216 217 218 219
ld/li negative
- 202 203 204 205 206 207 208
+ 220 221 222 223 224 225 226
lu positive
- 209 210 211 212 213
+ 227 228 229 230 231
lu negative
- 214
+ 232
lx positive
- 215 216 217 218 219 220
+ 233 234 235 236 237 238
lx negative
- 221
+ 239
lX positive
- 222 223 224 225 226 227
+ 240 241 242 243 244 245
lx negative
- 228
+ 246
lo positive
- 229 230 231 232 233 234
+ 247 248 249 250 251 252
lo negative
- 235
+ 253
Ld/Li positive
- 236 237 238 239 240
+ 254 255 256 257 258
Ld/Li negative
- 241 242 243 244 245
+ 259 260 261 262 263
Lu positive
- 246 247 248 249 250
+ 264 265 266 267 268
Lu negative
- 251
+ 269
Lx positive
- 252 253 254 255 256 257
+ 270 271 272 273 274 275
Lx negative
- 258
+ 276
LX positive
- 259 260 261 262 263 264
+ 277 278 279 280 281 282
Lx negative
- 265
+ 283
Lo positive
- 266 267 268 269 270 271
+ 284 285 286 287 288 289
Lo negative
- 272
+ 290
a
- 273
+ 291
t
- 274
+ 292
{...%}
- 275
+ 293
(...%)
- 276
+ 294
! % @ , and constants
- 277 278 279 280 281 282 283
+ 295 296 297 298 299 300 301
end of tests
All tests succeeded.
+++ /dev/null
-tscanf2_master.ml
(* TEST
include testing
+ compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
*)
(*
+++ /dev/null
-testmap.ml
-testset.ml
+++ /dev/null
-test_stdlabels.ml
+++ /dev/null
-pervasives_deprecated.ml
+++ /dev/null
-count_concat_bug.ml
-mpr7769.ml
+++ /dev/null
-test_string.ml
--- /dev/null
+(* TEST
+*)
+
+module M : sig
+ type t [@@immediate64]
+ val zero : t
+ val one : t
+ val add : t -> t -> t
+end = struct
+
+ include Sys.Immediate64.Make(Int)(Int64)
+
+ module type S = sig
+ val zero : t
+ val one : t
+ val add : t -> t -> t
+ end
+
+ let impl : (module S) =
+ match repr with
+ | Immediate ->
+ (module Int : S)
+ | Non_immediate ->
+ (module Int64 : S)
+
+ include (val impl : S)
+end
+
+let () =
+ match Sys.word_size with
+ | 64 -> assert (Obj.is_int (Obj.repr M.zero))
+ | _ -> assert (Obj.is_block (Obj.repr M.zero))
+++ /dev/null
-testfork.ml
-testpreempt.ml
-testyield.ml
-threadsigmask.ml
(* TEST
(* Test that yielding between busy threads reliably triggers a thread
switch. *)
+ * hassysthreads
include systhreads
- * not-windows
- ** bytecode
- ** native
+ ** not-windows
+ *** bytecode
+ *** native
*)
let threads = 4
+++ /dev/null
-backtrace_threads.ml
-bank.ml
-beat.ml
-bufchan.ml
-close.ml
-delayintr.ml
-fileio.ml
-pr4466.ml
-pr5325.ml
-pr7638.ml
-prodcons.ml
-prodcons2.ml
-sieve.ml
-signal.ml
-sockets.ml
-swapchan.ml
-tls.ml
-torture.ml
#include <winbase.h>
#include <winerror.h>
-void process_fd(char * s)
+void process_fd(const char * s)
{
int fd;
HANDLE h;
#include <sys/stat.h>
#include <unistd.h>
-void process_fd(char * s)
+void process_fd(const char * s)
{
long n;
int fd;
+++ /dev/null
-channel_of.ml
-cloexec.ml
-dup2.ml
-dup.ml
-pipe_eof.ml
-redirections.ml
-rename.ml
-test_unix_cmdline.ml
-utimes.ml
-wait_nohang.ml
-getaddrinfo.ml
-process_pid.ml
** native
*)
-let null =
- if Sys.win32 then
- "NUL"
- else
- "/dev/null"
-
let () =
let ic, _ as process =
(* Redirect to null to avoid
"The process tried to write to a nonexistent pipe." on Windows *)
- Printf.ksprintf Unix.open_process "echo toto > %s" null
+ Printf.ksprintf Unix.open_process "echo toto > %s" Filename.null
in
assert
(Unix.process_pid process = Unix.process_pid process);
--- /dev/null
+(* TEST
+include unix
+* hasunix
+** bytecode
+** native
+*)
+
+let str = "Hello, OCaml!"
+let txt = "truncate.txt"
+
+let test file openfile stat truncate delta close =
+ let () =
+ let c = open_out_bin file in
+ output_string c str;
+ close_out c
+ in
+ let size file =
+ (stat file).Unix.st_size
+ in
+ let file = openfile file in
+ Printf.printf "initial size: %d\n%!" (size file);
+ truncate file (size file - delta);
+ Printf.printf "new size: %d\n%!" (size file);
+ truncate file 0;
+ Printf.printf "final size: %d\n%!" (size file);
+ close file
+
+let () =
+ test "truncate.txt" (fun x -> x) Unix.stat Unix.truncate 2 ignore
+
+let () =
+ let open_it file = Unix.openfile file [O_RDWR] 0 in
+ test "ftruncate.txt" open_it Unix.fstat Unix.ftruncate 3 Unix.close
--- /dev/null
+initial size: 13
+new size: 11
+final size: 0
+initial size: 13
+new size: 10
+final size: 0
+++ /dev/null
-isatty_std.ml
-isatty_tty.ml
+++ /dev/null
-recvfrom_unix.ml
-recvfrom_linux.ml
(* TEST
include unix
modules = "recvfrom.ml"
-* not-windows
-** bytecode
-** native
+* hasunix
+** not-windows
+*** bytecode
+*** native
*)
open Recvfrom
+++ /dev/null
-test_env.ml
+++ /dev/null
-tupled.ml
-tupled2.ml
[%%expect{|
exception Exit
val r : string ref = {contents = ""}
-Line _, characters 4-25:
- | true | exception Exit when r := "hello"; true -> !r
- ^^^^^^^^^^^^^^^^^^^^^
+Line 7, characters 4-25:
+7 | | true | exception Exit when r := "hello"; true -> !r
+ ^^^^^^^^^^^^^^^^^^^^^
Error: Mixing value and exception patterns under when-guards is not supported.
|}]
;;
[%%expect{|
-Line _, characters 2-43:
- match f () with exception Not_found -> ()
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Line 2, characters 2-43:
+2 | match f () with exception Not_found -> ()
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: None of the patterns in this 'match' expression match values.
|}]
;;
+++ /dev/null
-exhaustiveness_warnings.ml
;;
[%%expect{|
-Line _, characters 7-18:
- with exception _ -> ()
- ^^^^^^^^^^^
+Line 3, characters 7-18:
+3 | with exception _ -> ()
+ ^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 4-17:
- | (exception _) as _pat -> ()
- ^^^^^^^^^^^^^
+Line 3, characters 4-17:
+3 | | (exception _) as _pat -> ()
+ ^^^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 8-19:
- | (_, exception _, _) -> ()
- ^^^^^^^^^^^
+Line 3, characters 8-19:
+3 | | (_, exception _, _) -> ()
+ ^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 9-22:
- | lazy (exception _) -> ()
- ^^^^^^^^^^^^^
+Line 3, characters 9-22:
+3 | | lazy (exception _) -> ()
+ ^^^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 17-28:
- | { contents = exception _ } -> ()
- ^^^^^^^^^^^
+Line 3, characters 17-28:
+3 | | { contents = exception _ } -> ()
+ ^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 7-18:
- | [| exception _ |] -> ()
- ^^^^^^^^^^^
+Line 3, characters 7-18:
+3 | | [| exception _ |] -> ()
+ ^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 9-22:
- | Some (exception _) -> ()
- ^^^^^^^^^^^^^
+Line 3, characters 9-22:
+3 | | Some (exception _) -> ()
+ ^^^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 7-20:
- | `A (exception _) -> ()
- ^^^^^^^^^^^^^
+Line 3, characters 7-20:
+3 | | `A (exception _) -> ()
+ ^^^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
;;
[%%expect{|
-Line _, characters 4-15:
- | exception _ -> ()
- ^^^^^^^^^^^
+Line 2, characters 4-15:
+2 | | exception _ -> ()
+ ^^^^^^^^^^^
Error: Exception patterns are not allowed in this position.
|}]
;;
[%%expect{|
-Line _, characters 14-15:
- | exception _ -> .
- ^
+Line 4, characters 14-15:
+4 | | exception _ -> .
+ ^
Error: This match case could not be refuted.
Here is an example of a value that would reach it: _
|}]
;;
[%%expect{|
-Line _, characters 21-22:
- | None | exception _ -> .
- ^
+Line 4, characters 21-22:
+4 | | None | exception _ -> .
+ ^
Error: This match case could not be refuted.
Here is an example of a value that would reach it: _
|}]
[%%expect{|
-Line _, characters 14-23:
- | exception Not_found | None -> .
- ^^^^^^^^^
+Line 4, characters 14-23:
+4 | | exception Not_found | None -> .
+ ^^^^^^^^^
Error: This match case could not be refuted.
Here is an example of a value that would reach it: Not_found
|}]
+++ /dev/null
-allocation.ml
-exception_propagation.ml
-identifier_sharing.ml
-match_failure.ml
-nested_handlers.ml
-raise_from_success_continuation.ml
-streams.ml
-tail_calls.ml
+++ /dev/null
-precise_locations.ml
Line 2, characters 1-4:
2 | #bar) -> ();;
^^^
-Error: Unbound class bar
+Error: Unbound class type bar
|}];;
function
#warnings "@3";;
let x =
Foo ();;
-(* "Foo ()": the whole construct, with arguments, is deprecated *)
+
[%%expect{|
type t = Foo of unit | Bar
-Line 6, characters 0-6:
+Line 6, characters 0-3:
6 | Foo ();;
- ^^^^^^
+ ^^^
Error (alert deprecated): Foo
|}];;
function
Foo _ -> () | Bar -> ();;
-(* "Foo _", the whole construct is deprecated *)
+
[%%expect{|
-Line 2, characters 0-5:
+Line 2, characters 0-3:
2 | Foo _ -> () | Bar -> ();;
- ^^^^^
+ ^^^
Error (alert deprecated): Foo
|}];;
+++ /dev/null
-almabench.ml
-fft.ml
-quicksort.ml
-soli.ml
+++ /dev/null
-bdd.ml
-boyer.ml
-ephetest.ml
-ephetest2.ml
-ephetest3.ml
-fib.ml
-finaliser.ml
-gcwords.ml
-gpr1370.ml
-hamming.ml
-nucleic.ml
-pr7168.ml
-sieve.ml
-sorts.ml
-takc.ml
-taku.ml
-weaklifetime.ml
-weaklifetime2.ml
-weaktest.ml
+++ /dev/null
-aliases.ml
-gpr2235.ml
--- /dev/null
+#include <caml/mlvalues.h>
+#include <stdio.h>
+
+value caml_puts(value s)
+{
+ puts(String_val(s));
+ return Val_unit;
+}
--- /dev/null
+(* TEST
+
+files = "puts.c"
+use_runtime = "false"
+
+* hasunix
+include unix
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+flags = "-w a -output-complete-exe puts.c -ccopt -I${ocamlsrcdir}/runtime"
+program = "test2"
+**** run
+program = "./test2"
+***** check-program-output
+*)
+
+external puts: string -> unit = "caml_puts"
+
+let () =
+ Unix.putenv "FOO" "Hello OCaml!";
+ puts (Unix.getenv "FOO")
--- /dev/null
+Hello OCaml!
+++ /dev/null
-escape_error.ml
-expecting.ml
-pr7847.ml
-unclosed_class_signature.mli
-unclosed_class_simpl_expr1.ml
-unclosed_class_simpl_expr2.ml
-unclosed_class_simpl_expr3.ml
-unclosed_object.ml
-unclosed_paren_module_expr1.ml
-unclosed_paren_module_expr2.ml
-unclosed_paren_module_expr3.ml
-unclosed_paren_module_expr4.ml
-unclosed_paren_module_expr5.ml
-unclosed_paren_module_type.mli
-unclosed_sig.mli
-unclosed_simple_expr.ml
-unclosed_simple_pattern.ml
-unclosed_struct.ml
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct (** foo *)
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
[%%expect {|
module M = struct [@@@ocaml.text " foo "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
module M = struct [@@@ocaml.text " foo "]
[@@@ocaml.text " bar "] end;;
-module M : sig end
+module M : sig end
|}]
module M = struct
module M = struct [@@@ocaml.text " foo "]
[@@@ocaml.text " bar "] end;;
-module M : sig end
+module M : sig end
|}]
[ `Foo [@ocaml.doc " foo "] | `Bar of (int * string) [@ocaml.doc " bar "]];;
type var = [ `Bar of int * string | `Foo ]
|}]
+
+module type S = sig
+
+ val before : unit -> unit
+ (** docstring before *)
+ [@@@foo]
+
+ [@@@foo]
+ (** docstring after *)
+ val after : unit -> unit
+
+end;;
+[%%expect {|
+
+module type S =
+ sig
+ val before : unit -> unit[@@ocaml.doc " docstring before "]
+ [@@@foo ]
+ [@@@foo ]
+ val after : unit -> unit[@@ocaml.doc " docstring after "]
+ end;;
+module type S = sig val before : unit -> unit val after : unit -> unit end
+|}]
+++ /dev/null
-[
- structure_item (extended_indexoperators.ml[8,120+0]..[8,120+29])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[8,120+4]..[8,120+10])
- Ppat_var ".?[]" (extended_indexoperators.ml[8,120+4]..[8,120+10])
- expression (extended_indexoperators.ml[8,120+13]..[8,120+29])
- Pexp_ident "Hashtbl.find_opt" (extended_indexoperators.ml[8,120+13]..[8,120+29])
- ]
- structure_item (extended_indexoperators.ml[9,150+0]..[9,150+25])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[9,150+4]..[9,150+10])
- Ppat_var ".@[]" (extended_indexoperators.ml[9,150+4]..[9,150+10])
- expression (extended_indexoperators.ml[9,150+13]..[9,150+25])
- Pexp_ident "Hashtbl.find" (extended_indexoperators.ml[9,150+13]..[9,150+25])
- ]
- structure_item (extended_indexoperators.ml[10,176+0]..[10,176+28])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[10,176+4]..[10,176+14])
- Ppat_var ".@[]<-" (extended_indexoperators.ml[10,176+4]..[10,176+14])
- expression (extended_indexoperators.ml[10,176+17]..[10,176+28])
- Pexp_ident "Hashtbl.add" (extended_indexoperators.ml[10,176+17]..[10,176+28])
- ]
- structure_item (extended_indexoperators.ml[11,205+0]..[11,205+25])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[11,205+4]..[11,205+10])
- Ppat_var ".@{}" (extended_indexoperators.ml[11,205+4]..[11,205+10])
- expression (extended_indexoperators.ml[11,205+13]..[11,205+25])
- Pexp_ident "Hashtbl.find" (extended_indexoperators.ml[11,205+13]..[11,205+25])
- ]
- structure_item (extended_indexoperators.ml[12,231+0]..[12,231+28])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[12,231+4]..[12,231+14])
- Ppat_var ".@{}<-" (extended_indexoperators.ml[12,231+4]..[12,231+14])
- expression (extended_indexoperators.ml[12,231+17]..[12,231+28])
- Pexp_ident "Hashtbl.add" (extended_indexoperators.ml[12,231+17]..[12,231+28])
- ]
- structure_item (extended_indexoperators.ml[13,260+0]..[13,260+25])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[13,260+4]..[13,260+10])
- Ppat_var ".@()" (extended_indexoperators.ml[13,260+4]..[13,260+10])
- expression (extended_indexoperators.ml[13,260+13]..[13,260+25])
- Pexp_ident "Hashtbl.find" (extended_indexoperators.ml[13,260+13]..[13,260+25])
- ]
- structure_item (extended_indexoperators.ml[14,286+0]..[14,286+28])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[14,286+4]..[14,286+14])
- Ppat_var ".@()<-" (extended_indexoperators.ml[14,286+4]..[14,286+14])
- expression (extended_indexoperators.ml[14,286+17]..[14,286+28])
- Pexp_ident "Hashtbl.add" (extended_indexoperators.ml[14,286+17]..[14,286+28])
- ]
- structure_item (extended_indexoperators.ml[16,316+0]..[16,316+25])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[16,316+4]..[16,316+5])
- Ppat_var "h" (extended_indexoperators.ml[16,316+4]..[16,316+5])
- expression (extended_indexoperators.ml[16,316+8]..[16,316+25])
- Pexp_apply
- expression (extended_indexoperators.ml[16,316+8]..[16,316+22])
- Pexp_ident "Hashtbl.create" (extended_indexoperators.ml[16,316+8]..[16,316+22])
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[16,316+23]..[16,316+25])
- Pexp_constant PConst_int (17,None)
- ]
- ]
- structure_item (extended_indexoperators.ml[19,346+2]..[22,413+28])
- Pstr_eval
- expression (extended_indexoperators.ml[19,346+2]..[22,413+28])
- Pexp_sequence
- expression (extended_indexoperators.ml[19,346+2]..[19,346+17])
- Pexp_apply
- expression (extended_indexoperators.ml[19,346+2]..[19,346+17])
- Pexp_ident ".@()<-" (extended_indexoperators.ml[19,346+2]..[19,346+17]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[19,346+2]..[19,346+3])
- Pexp_ident "h" (extended_indexoperators.ml[19,346+2]..[19,346+3])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[19,346+6]..[19,346+11])
- Pexp_constant PConst_string("One",None)
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[19,346+16]..[19,346+17])
- Pexp_constant PConst_int (1,None)
- ]
- expression (extended_indexoperators.ml[20,364+2]..[22,413+28])
- Pexp_sequence
- expression (extended_indexoperators.ml[20,364+2]..[20,364+25])
- Pexp_assert
- expression (extended_indexoperators.ml[20,364+9]..[20,364+25])
- Pexp_apply
- expression (extended_indexoperators.ml[20,364+21]..[20,364+22])
- Pexp_ident "=" (extended_indexoperators.ml[20,364+21]..[20,364+22])
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[20,364+10]..[20,364+20])
- Pexp_apply
- expression (extended_indexoperators.ml[20,364+10]..[20,364+20])
- Pexp_ident ".@{}" (extended_indexoperators.ml[20,364+10]..[20,364+20]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[20,364+10]..[20,364+11])
- Pexp_ident "h" (extended_indexoperators.ml[20,364+10]..[20,364+11])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[20,364+14]..[20,364+19])
- Pexp_constant PConst_string("One",None)
- ]
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[20,364+23]..[20,364+24])
- Pexp_constant PConst_int (1,None)
- ]
- expression (extended_indexoperators.ml[21,390+2]..[22,413+28])
- Pexp_sequence
- expression (extended_indexoperators.ml[21,390+2]..[21,390+22])
- Pexp_apply
- expression (extended_indexoperators.ml[21,390+2]..[21,390+11])
- Pexp_ident "print_int" (extended_indexoperators.ml[21,390+2]..[21,390+11])
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[21,390+12]..[21,390+22])
- Pexp_apply
- expression (extended_indexoperators.ml[21,390+12]..[21,390+22])
- Pexp_ident ".@{}" (extended_indexoperators.ml[21,390+12]..[21,390+22]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[21,390+12]..[21,390+13])
- Pexp_ident "h" (extended_indexoperators.ml[21,390+12]..[21,390+13])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[21,390+16]..[21,390+21])
- Pexp_constant PConst_string("One",None)
- ]
- ]
- expression (extended_indexoperators.ml[22,413+2]..[22,413+28])
- Pexp_assert
- expression (extended_indexoperators.ml[22,413+9]..[22,413+28])
- Pexp_apply
- expression (extended_indexoperators.ml[22,413+21]..[22,413+22])
- Pexp_ident "=" (extended_indexoperators.ml[22,413+21]..[22,413+22])
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[22,413+10]..[22,413+20])
- Pexp_apply
- expression (extended_indexoperators.ml[22,413+10]..[22,413+20])
- Pexp_ident ".?[]" (extended_indexoperators.ml[22,413+10]..[22,413+20]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[22,413+10]..[22,413+11])
- Pexp_ident "h" (extended_indexoperators.ml[22,413+10]..[22,413+11])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[22,413+14]..[22,413+19])
- Pexp_constant PConst_string("Two",None)
- ]
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[22,413+23]..[22,413+27])
- Pexp_construct "None" (extended_indexoperators.ml[22,413+23]..[22,413+27])
- None
- ]
- structure_item (extended_indexoperators.ml[26,464+0]..[26,464+23])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[26,464+4]..[26,464+10])
- Ppat_var "#?" (extended_indexoperators.ml[26,464+4]..[26,464+10])
- expression (extended_indexoperators.ml[26,464+11]..[26,464+23]) ghost
- Pexp_fun
- Nolabel
- None
- pattern (extended_indexoperators.ml[26,464+11]..[26,464+12])
- Ppat_var "x" (extended_indexoperators.ml[26,464+11]..[26,464+12])
- expression (extended_indexoperators.ml[26,464+13]..[26,464+23]) ghost
- Pexp_fun
- Nolabel
- None
- pattern (extended_indexoperators.ml[26,464+13]..[26,464+14])
- Ppat_var "y" (extended_indexoperators.ml[26,464+13]..[26,464+14])
- expression (extended_indexoperators.ml[26,464+17]..[26,464+23])
- Pexp_tuple
- [
- expression (extended_indexoperators.ml[26,464+18]..[26,464+19])
- Pexp_ident "x" (extended_indexoperators.ml[26,464+18]..[26,464+19])
- expression (extended_indexoperators.ml[26,464+21]..[26,464+22])
- Pexp_ident "y" (extended_indexoperators.ml[26,464+21]..[26,464+22])
- ]
- ]
- structure_item (extended_indexoperators.ml[27,490+0]..[27,490+24])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[27,490+4]..[27,490+12])
- Ppat_var ".%()" (extended_indexoperators.ml[27,490+4]..[27,490+12])
- expression (extended_indexoperators.ml[27,490+13]..[27,490+24]) ghost
- Pexp_fun
- Nolabel
- None
- pattern (extended_indexoperators.ml[27,490+13]..[27,490+14])
- Ppat_var "x" (extended_indexoperators.ml[27,490+13]..[27,490+14])
- expression (extended_indexoperators.ml[27,490+15]..[27,490+24]) ghost
- Pexp_fun
- Nolabel
- None
- pattern (extended_indexoperators.ml[27,490+15]..[27,490+16])
- Ppat_var "y" (extended_indexoperators.ml[27,490+15]..[27,490+16])
- expression (extended_indexoperators.ml[27,490+19]..[27,490+24])
- Pexp_apply
- expression (extended_indexoperators.ml[27,490+19]..[27,490+24]) ghost
- Pexp_ident "Array.get" (extended_indexoperators.ml[27,490+19]..[27,490+24]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[27,490+19]..[27,490+20])
- Pexp_ident "x" (extended_indexoperators.ml[27,490+19]..[27,490+20])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[27,490+22]..[27,490+23])
- Pexp_ident "y" (extended_indexoperators.ml[27,490+22]..[27,490+23])
- ]
- ]
- structure_item (extended_indexoperators.ml[28,517+0]..[28,517+15])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[28,517+4]..[28,517+5])
- Ppat_var "x" (extended_indexoperators.ml[28,517+4]..[28,517+5])
- expression (extended_indexoperators.ml[28,517+8]..[28,517+15])
- Pexp_array
- [
- expression (extended_indexoperators.ml[28,517+11]..[28,517+12])
- Pexp_constant PConst_int (0,None)
- ]
- ]
- structure_item (extended_indexoperators.ml[29,535+0]..[29,535+18])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[29,535+4]..[29,535+5])
- Ppat_any
- expression (extended_indexoperators.ml[29,535+8]..[29,535+18])
- Pexp_apply
- expression (extended_indexoperators.ml[29,535+10]..[29,535+12])
- Pexp_ident "#?" (extended_indexoperators.ml[29,535+10]..[29,535+12])
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[29,535+8]..[29,535+9])
- Pexp_constant PConst_int (1,None)
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[29,535+13]..[29,535+18])
- Pexp_apply
- expression (extended_indexoperators.ml[29,535+13]..[29,535+18]) ghost
- Pexp_ident "Array.get" (extended_indexoperators.ml[29,535+13]..[29,535+18]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[29,535+13]..[29,535+14])
- Pexp_ident "x" (extended_indexoperators.ml[29,535+13]..[29,535+14])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[29,535+16]..[29,535+17])
- Pexp_constant PConst_int (0,None)
- ]
- ]
- ]
- structure_item (extended_indexoperators.ml[30,556+0]..[30,556+19])
- Pstr_value Nonrec
- [
- <def>
- pattern (extended_indexoperators.ml[30,556+4]..[30,556+5])
- Ppat_any
- expression (extended_indexoperators.ml[30,556+8]..[30,556+19])
- Pexp_apply
- expression (extended_indexoperators.ml[30,556+10]..[30,556+12])
- Pexp_ident "#?" (extended_indexoperators.ml[30,556+10]..[30,556+12])
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[30,556+8]..[30,556+9])
- Pexp_constant PConst_int (1,None)
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[30,556+13]..[30,556+19])
- Pexp_apply
- expression (extended_indexoperators.ml[30,556+13]..[30,556+19])
- Pexp_ident ".%()" (extended_indexoperators.ml[30,556+13]..[30,556+19]) ghost
- [
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[30,556+13]..[30,556+14])
- Pexp_ident "x" (extended_indexoperators.ml[30,556+13]..[30,556+14])
- <arg>
- Nolabel
- expression (extended_indexoperators.ml[30,556+17]..[30,556+18])
- Pexp_constant PConst_int (0,None)
- ]
- ]
- ]
-]
-
(* TEST
- flags = "-dparsetree"
- * setup-ocamlc.byte-build-env
- ** ocamlc.byte
- *** check-ocamlc.byte-output
+ * expect
+ flags = "-dsource"
*)
let (.?[]) = Hashtbl.find_opt
let (.@{}) = Hashtbl.find
let ( .@{}<- ) = Hashtbl.add
let (.@()) = Hashtbl.find
-let ( .@()<- ) = Hashtbl.add
+let ( .@()<- ) = Hashtbl.add ;;
+[%%expect {|
-let h = Hashtbl.create 17
+let (.?[]) = Hashtbl.find_opt;;
+val ( .?[] ) : ('a, 'b) Hashtbl.t -> 'a -> 'b option = <fun>
-;;
- h.@("One") <- 1
+let (.@[]) = Hashtbl.find;;
+val ( .@[] ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = <fun>
+
+let (.@[]<-) = Hashtbl.add;;
+val ( .@[]<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
+
+let (.@{}) = Hashtbl.find;;
+val ( .@{} ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = <fun>
+
+let (.@{}<-) = Hashtbl.add;;
+val ( .@{}<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
+
+let (.@()) = Hashtbl.find;;
+val ( .@() ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = <fun>
+
+let (.@()<-) = Hashtbl.add;;
+val ( .@()<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
+|}]
+
+let h: (string,int) Hashtbl.t = Hashtbl.create 17;;
+[%%expect {|
+
+let h : (string, int) Hashtbl.t = Hashtbl.create 17;;
+val h : (string, int) Hashtbl.t = <abstr>
+|}]
+
+let () =
+ h .@ ("One") <- 1
; assert (h.@{"One"} = 1)
-; print_int h.@{"One"}
+; Format.printf "%d" h.@{"One"}
; assert (h.?["Two"] = None)
+[%%expect {|
+
+let () =
+ h.@("One") <- 1;
+ assert ((h.@{"One"}) = 1);
+ Format.printf "%d" (h.@{"One"});
+ assert ((h.?["Two"]) = None);;
+|}]
(* from GPR#1392 *)
-let ( #? ) x y = (x, y);;
-let ( .%() ) x y = x.(y);;
-let x = [| 0 |];;
-let _ = 1 #? x.(0);;
+let ( #? ) x y = (x, y)
+let ( .%() ) x y = x.(y)
+let x = [| 0 |]
+let _ = 1 #? x.(0)
let _ = 1 #? x.%(0);;
+[%%expect {|
+
+let (#?) x y = (x, y);;
+val ( #? ) : 'a -> 'b -> 'a * 'b = <fun>
+
+let (.%()) x y = x.(y);;
+val ( .%() ) : 'a array -> int -> 'a = <fun>
+
+let x = [|0|];;
+val x : int array = [|0|]
+
+let _ = 1 #? (x.(0));;
+- : int * int = (1, 0)
+
+let _ = 1 #? (x.%(0));;
+- : int * int = (1, 0)
+|}]
+
+
+(* from GPR#1467 *)
+let _ = x.%(((); (); 0))
+let _ = x.%((Format.printf "hello"; 0))
+[%%expect {|
+
+let _ = x.%(((); (); 0));;
+- : int = 0
+
+let _ = x.%((Format.printf "hello"; 0));;
+- : int = 0
+|}]
--- /dev/null
+(* TEST
+ flags = "-dsource"
+ * expect
+*)
+
+module A = Bigarray.Genarray
+[%%expect {|
+
+module A = Bigarray.Genarray;;
+module A = Bigarray.Genarray
+|}]
+
+let (.%{;..}<-) = A.set
+let (.%{;..}) = A.get
+[%%expect {|
+
+let (.%{;..}<-) = A.set;;
+val ( .%{;..}<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = <fun>
+
+let (.%{;..}) = A.get;;
+val ( .%{;..} ) : ('a, 'b, 'c) A.t -> int array -> 'a = <fun>
+|}]
+
+let (.![;..]<-) = A.set
+let (.![;..]) a n =
+ (* Check the ordering of indices *)
+ Format.printf "indices: @[[|%a|]@]@."
+ (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
+ Format.pp_print_int) (Array.to_list n);
+ A.get a n
+[%%expect {|
+
+let (.![;..]<-) = A.set;;
+val ( .![;..]<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = <fun>
+
+let (.![;..]) a n =
+ Format.printf "indices: @[[|%a|]@]@."
+ (Format.pp_print_list
+ ~pp_sep:(fun ppf -> fun () -> Format.fprintf ppf ";@ ")
+ Format.pp_print_int) (Array.to_list n);
+ A.get a n;;
+val ( .![;..] ) : ('a, 'b, 'c) A.t -> int array -> 'a = <fun>
+|}]
+
+let (.?(;..)<-) = A.set
+let (.?(;..)) = A.get
+[%%expect {|
+
+let (.?(;..)<-) = A.set;;
+val ( .?(;..)<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = <fun>
+
+let (.?(;..)) = A.get;;
+val ( .?(;..) ) : ('a, 'b, 'c) A.t -> int array -> 'a = <fun>
+|}]
+
+let a = A.create Bigarray.float64 Bigarray.c_layout [|3;3;3|]
+[%%expect {|
+
+let a = A.create Bigarray.float64 Bigarray.c_layout [|3;3;3|];;
+val a : (float, Bigarray.float64_elt, Bigarray.c_layout) A.t = <abstr>
+|}]
+
+;; a.![1;0;0] <- 2.
+[%%expect {|
+
+;;a.![1;0;0] <- 2.;;
+- : unit = ()
+|}]
+;; a.?(0;1;0) <- 3.
+[%%expect {|
+
+;;a.?(0;1;0) <- 3.;;
+- : unit = ()
+|}]
+;; a.%{0;0;1} <- 5.
+[%%expect {|
+
+;;a.%{0;0;1} <- 5.;;
+- : unit = ()
+|}]
+
+;; a.![0;1;2] <- 7.;
+ a.![0;1;2]
+[%%expect {|
+
+;;a.![0;1;2] <- 7.; a.![0;1;2];;
+indices: [|0; 1; 2|]
+- : float = 7.
+|}]
+
+
+let (#+) = ( +. )
+[%%expect {|
+
+let (#+) = (+.);;
+val ( #+ ) : float -> float -> float = <fun>
+|}]
+
+;; a.?(1;0;0) #+ a.%{0;1;0} #+ a.![0;0;1]
+[%%expect {|
+
+;;((a.?(1;0;0)) #+ (a.%{0;1;0})) #+ (a.![0;0;1]);;
+indices: [|0; 0; 1|]
+- : float = 10.
+|}]
+
+let (.??[]) () () = ()
+;; ().??[(();())]
+ [%%expect {|
+
+let (.??[]) () () = ();;
+val ( .??[] ) : unit -> unit -> unit = <fun>
+
+;;().??[((); ())];;
+- : unit = ()
+|}]
+
+module M = struct
+ let (.%?(;..)) = A.get
+ let (.%?(;..)<-) = A.set
+ let (.%![;..]) = A.get
+ let (.%![;..]<-) = A.set
+ let (.%%{;..}) = A.get
+ let (.%%{;..}<-) = A.set
+end
+
+;; a.M.%![1;0;0] <- 7.
+[%%expect {|
+
+module M =
+ struct
+ let (.%?(;..)) = A.get
+ let (.%?(;..)<-) = A.set
+ let (.%![;..]) = A.get
+ let (.%![;..]<-) = A.set
+ let (.%%{;..}) = A.get
+ let (.%%{;..}<-) = A.set
+ end;;
+module M :
+ sig
+ val ( .%?(;..) ) : ('a, 'b, 'c) A.t -> int array -> 'a
+ val ( .%?(;..)<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit
+ val ( .%![;..] ) : ('a, 'b, 'c) A.t -> int array -> 'a
+ val ( .%![;..]<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit
+ val ( .%%{;..} ) : ('a, 'b, 'c) A.t -> int array -> 'a
+ val ( .%%{;..}<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit
+ end
+
+;;a.M.%![1;0;0] <- 7.;;
+- : unit = ()
+|}]
+;; a.M.%?(0;1;0) <- 11.
+[%%expect {|
+
+;;a.M.%?(0;1;0) <- 11.;;
+- : unit = ()
+|}]
+;; a.M.%%{0;0;1} <- 13.
+[%%expect {|
+
+;;a.M.%%{0;0;1} <- 13.;;
+- : unit = ()
+|}]
+
+;; a.M.%?(1;0;0) #+ a.M.%%{0;1;0} #+ a.M.%![0;0;1]
+[%%expect {|
+
+;;((a.M.%?(1;0;0)) #+ (a.M.%%{0;1;0})) #+ (a.M.%![0;0;1]);;
+- : float = 31.
+|}]
+++ /dev/null
-anonymous_class_parameter.ml
-arrow_ambiguity.ml
-attributes.ml
-broken_invariants.ml
-constructor_declarations.ml
-docstrings.ml
-extended_indexoperators.ml
-extensions.ml
-hash_ambiguity.ml
-int_and_float_with_modifier.ml
-pr6604_2.ml
-pr6604_3.ml
-pr6604.ml
-pr6865.ml
-pr7165.ml
-reloc.ml
-shortcut_ext_attr.ml
+++ /dev/null
-warning.ml
!Clflags.transparent_modules;
Printf.eprintf "unboxed_types: %B\n"
!Clflags.unboxed_types;
- Printf.eprintf "unsafe_string: %B\n"
- !Clflags.unsafe_string;
Printf.eprintf "</ppx-context>\n";
flush stderr;
default_mapper);
principal: true
transparent_modules: false
unboxed_types: true
-unsafe_string: false
</ppx-context>
<ppx-context>
tool_name: "ocamlc"
principal: false
transparent_modules: true
unboxed_types: false
-unsafe_string: true
</ppx-context>
-principal \
-alias-deps \
-unboxed-types \
- -safe-string \
-ppx ${program}"
**** ocamlc.byte
module = "test.ml"
flags = "-g \
-no-alias-deps \
-no-unboxed-types \
- -unsafe-string \
-ppx ${program}"
***** check-ocamlc.byte-output
*)
+++ /dev/null
-bigstring_access.ml
-string_access.ml
+++ /dev/null
-apply.ml
-revapply.ml
+++ /dev/null
-disambiguation.ml
-pr248.ml
+++ /dev/null
-gpr1623.ml
+++ /dev/null
-missing_set_of_closures.ml
--- /dev/null
+(* TEST
+ * bytecode
+ * native
+ * native
+ ocamlopt_flags = "-compact"
+*)
+
+type mut2 = { mutable p: int; mutable q:int }
+type mut3 = { mutable s: int; mutable t:int; mutable u:int }
+
+type mut_record =
+ { mutable a : int;
+ mutable b : int;
+ mutable c : int;
+ mutable d : int;
+ mutable e : int;
+ mutable f : int; }
+
+let go () =
+ let pre_before = Gc.minor_words () in
+ let before = Gc.minor_words () in
+ let alloc_per_minor_words = int_of_float (before -. pre_before) in
+ if Sys.backend_type = Sys.Native then assert (alloc_per_minor_words = 0);
+ let allocs = ref alloc_per_minor_words in
+ let n = 1_000_000 in
+ for i = 1 to n do
+ Sys.opaque_identity (ref i)
+ |> ignore;
+ allocs := !allocs + 2;
+ done;
+ for i = 1 to n do
+ Sys.opaque_identity { p = i; q = i }
+ |> ignore;
+ allocs := !allocs + 3;
+ done;
+ for i = 1 to n do
+ Sys.opaque_identity { s = i; t = i; u = i }
+ |> ignore;
+ allocs := !allocs + 4;
+ done;
+ for i = 1 to n do
+ Sys.opaque_identity { a = i; b = i; c = i; d = i; e = i; f = i }
+ |> ignore;
+ allocs := !allocs + 7;
+ if i mod (n/3) == 0 then Gc.full_major ();
+ done;
+ for i = 1 to n do
+ Sys.opaque_identity (Array.make 8 i)
+ |> ignore;
+ allocs := !allocs + 9;
+ if i mod (n/3) == 0 then Gc.compact ();
+ done;
+ let after = Gc.minor_words () in
+ let measured_allocs = int_of_float (after -. before) - alloc_per_minor_words in
+ Printf.printf "%d\n" (measured_allocs - !allocs)
+
+let () = go ()
--- /dev/null
+(* TEST *)
+
+let f n = ((n lsl 1) + 1) / 2
+let g n = (n lsl 1) / 2
+let h n = Int64.of_int (n * 2 + 1)
+let i n = Int64.of_int (Int64.to_int n)
+
+let r = Sys.opaque_identity max_int
+let s = Sys.opaque_identity Int64.max_int
+let () = Printf.printf "%d\n%d\n%Ld\n%Ld\n" (f r) (g r) (h r) (i s)
--- /dev/null
+0
+-1
+-1
+-1
--- /dev/null
+(* TEST *)
+
+let () =
+ Gc.set { (Gc.get ()) with allocation_policy = 2 };
+ ignore (Array.init 5_000 (fun _ -> Array.make 10_000 0));
+ Gc.full_major ()
+++ /dev/null
-stackoverflow.ml
-syserror.ml
--- /dev/null
+(* TEST *)
+
+(* Marshaling (cf. PR#5436) *)
+
+(* Note: this test must *not* be made a toplevel or expect-style test,
+ because then the Obj.id counter of the compiler implementation
+ (called by the bytecode read-eval-print loop) would be the same as
+ the Obj.id counter of the test code below. In particular, any
+ change to the compiler implementation to use more objects or
+ exceptions would change the numbers below, making the test very
+ fragile. *)
+
+let r = ref 0;;
+let id o = Oo.id o - !r;;
+r := Oo.id (object end);;
+
+assert (id (object end) = 1);;
+assert (id (object end) = 2);;
+let o = object end in
+ let s = Marshal.to_string o [] in
+ let o' : < > = Marshal.from_string s 0 in
+ let o'' : < > = Marshal.from_string s 0 in
+ assert ((id o, id o', id o'') = (3, 4, 5));
+
+let o = object val x = 33 method m = x end in
+ let s = Marshal.to_string o [Marshal.Closures] in
+ let o' : <m:int> = Marshal.from_string s 0 in
+ let o'' : <m:int> = Marshal.from_string s 0 in
+ assert ((id o, id o', id o'', o#m, o'#m)
+ = (6, 7, 8, 33, 33));;
+
+let o = object val x = 33 val y = 44 method m = x end in
+ let s = Marshal.to_string (o,o) [Marshal.Closures] in
+ let (o1, o2) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
+ let (o3, o4) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
+ assert ((id o, id o1, id o2, id o3, id o4, o#m, o1#m)
+ = (9, 10, 10, 11, 11, 33, 33));;
+++ /dev/null
-artificial.ml
-cannot_shadow_error.ml
-shadow_all.ml
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included module type T/317 by T/335
+Error: Illegal shadowing of included module type T/317 by T/334
Line 2, characters 2-11:
Module type T/317 came from this include
Line 3, characters 2-39:
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included type ext/353 by ext/370
+Error: Illegal shadowing of included type ext/352 by ext/369
Line 2, characters 2-11:
- Type ext/353 came from this include
+ Type ext/352 came from this include
Line 3, characters 14-16:
- The extension constructor C2 has no valid type if ext/353 is shadowed
+ The extension constructor C2 has no valid type if ext/352 is shadowed
|}]
module type Class = sig
type t
val unit : unit
external e : unit -> unit = "%identity"
- module M : sig end
- module type T = sig end
+ module M : sig end
+ module type T = sig end
exception E
type ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
[%%expect{|
module Module_type :
sig
- module type U = sig end
+ module type U = sig end
type t = N.t
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = sig end
exception E
type ext = N.ext = ..
type ext += C
--- /dev/null
+\begin{caml_example*}{verbatim}
+let start = 0
+[@@@ellipsis.start]
+let hidden = succ start
+[@@@ellipsis.stop]
+let mid = succ hidden
+let[@ellipsis] statement = succ mid
+
+module E = struct end
+include E[@@ellipsis]
+
+let expr = succ statement[@ellipsis]
+
+let pat = match start with
+ | 0[@ellipsis] | 1 -> succ expr
+ | _ -> succ expr
+
+let case = match start with
+ | 0 -> succ pat
+ | _[@ellipsis.start] -> succ pat[@ellipsis.stop]
+
+
+let annot: int[@ellipsis] = succ case
+
+let subexpr = succ annot + (2[@ellipsis.stop] - 1[@ellipsis.start] * 2) - 2
+
+class[@ellipsis] c = object val x = succ subexpr end
+
+class c2 = object
+ val[@ellipsis] x = 0
+ val y = 1
+ method[@ellipsis] m = 2
+ method n = 3
+ [@@@ellipsis.start]
+ method l = 4
+ [@@@ellipsis.stop]
+end
+
+type t = A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F
+type arrow = int -> (int -> int[@ellipsis])
+type record = { a:int; b:int[@ellipsis]; c:int;
+ d:int[@ellipsis.start]; e:int; f:int[@ellipsis.stop];
+ g:int }
+type polyvar = [`A|`B[@ellipsis] |`C
+ |`D[@ellipsis.start] | `E | `F [@ellipsis.stop]
+ | `G ]
+type exn += A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F
+\end{caml_example*}
(* TEST
reference="${test_source_directory}/ellipses.reference"
output="ellipses.output"
+ files="${test_source_directory}/ellipses.input"
script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}"
+ -repo-root ${ocamlsrcdir} ${files} -o ${output}"
* hasstr
** native-compiler
*** shared-libraries
**** script with unix,str
***** check-program-output
*)
-
-\begin{caml_example*}{verbatim}
-let start = 0
-[@@@ellipsis.start]
-let hidden = succ start
-[@@@ellipsis.stop]
-let mid = succ hidden
-let[@ellipsis] statement = succ mid
-
-module E = struct end
-include E[@@ellipsis]
-
-let expr = succ statement[@ellipsis]
-
-let pat = match start with
- | 0[@ellipsis] | 1 -> succ expr
- | _ -> succ expr
-
-let case = match start with
- | 0 -> succ pat
- | _[@ellipsis.start] -> succ pat[@ellipsis.stop]
-
-
-let annot: int[@ellipsis] = succ case
-
-let subexpr = succ annot + (2[@ellipsis.stop] - 1[@ellipsis.start] * 2) - 2
-
-class[@ellipsis] c = object val x = succ subexpr end
-
-class c2 = object
- val[@ellipsis] x = 0
- val y = 1
- method[@ellipsis] m = 2
- method n = 3
- [@@@ellipsis.start]
- method l = 4
- [@@@ellipsis.stop]
-end
-
-type t = A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F
-type arrow = int -> (int -> int[@ellipsis])
-type record = { a:int; b:int[@ellipsis]; c:int;
- d:int[@ellipsis.start]; e:int; f:int[@ellipsis.stop];
- g:int }
-type polyvar = [`A|`B[@ellipsis] |`C
- |`D[@ellipsis.start] | `E | `F [@ellipsis.stop]
- | `G ]
-type exn += A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F
-\end{caml_example*}
-(* TEST
- reference="${test_source_directory}/ellipses.reference"
- output="ellipses.output"
- script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}"
- * hasstr
- ** native-compiler
- *** shared-libraries
- **** script with unix,str
- ***** check-program-output
-*)
-
-\camlexample{verbatim}
-\caml\camlinput\?let start = 0
-\?\ldots
-\?let mid = succ hidden
-\?\ldots
-
-\?module E = struct end
-\?\ldots
-
-\?let expr = \ldots
-
-\?let pat = match start with
-\? | \ldots | 1 -> succ expr
-\? | _ -> succ expr
-
-\?let case = match start with
-\? | 0 -> succ pat
-\? | \ldots
-
-
-\?let annot: \ldots = succ case
-
-\?let subexpr = succ annot + (\ldots * 2) - 2
-
-\?\ldots
-
-\?class c2 = object
-\? \ldots
-\? val y = 1
-\? \ldots
-\? method n = 3
-\? \ldots
-\?end
-
-\?type t = \ldots | B \ldots | F
-\?type arrow = int -> (\ldots)
-\?type record = { a:int; \ldots c:int;
-\? \ldots
-\? g:int }
-\?type polyvar = [\textasciigrave\-A|\ldots |\textasciigrave\-C
-\? |\ldots
-\? | \textasciigrave\-G ]
-\?type exn += \ldots | B \ldots | F
-\endcamlinput
-\endcaml
-\endcamlexample
+\begin{camlexample}{verbatim}
+\begin{caml}
+\begin{camlinput}
+$\?$let start = 0
+$\?$$\ldots$
+$\?$let mid = succ hidden
+$\?$$\ldots$
+
+$\?$module E = struct end
+$\?$$\ldots$
+
+$\?$let expr = $\ldots$
+
+$\?$let pat = match start with
+$\?$ | $\ldots$ | 1 -> succ expr
+$\?$ | _ -> succ expr
+
+$\?$let case = match start with
+$\?$ | 0 -> succ pat
+$\?$ | $\ldots$
+
+
+$\?$let annot: $\ldots$ = succ case
+
+$\?$let subexpr = succ annot + ($\ldots$ * 2) - 2
+
+$\?$$\ldots$
+
+$\?$class c2 = object
+$\?$ $\ldots$
+$\?$ val y = 1
+$\?$ $\ldots$
+$\?$ method n = 3
+$\?$ $\ldots$
+$\?$end
+
+$\?$type t = $\ldots$ | B $\ldots$ | F
+$\?$type arrow = int -> ($\ldots$)
+$\?$type record = { a:int; $\ldots$ c:int;
+$\?$ $\ldots$
+$\?$ g:int }
+$\?$type polyvar = [`A|$\ldots$ |`C
+$\?$ |$\ldots$
+$\?$ | `G ]
+$\?$type exn += $\ldots$ | B $\ldots$ | F
+\end{camlinput}
+\end{caml}
+\end{camlexample}
+++ /dev/null
-ellipses.ml
-redirections.ml
--- /dev/null
+\begin{caml_example}{toplevel}
+[@@@warning "+A"];;
+1 + 2. [@@expect error];;
+let f x = () [@@expect warning 27];;
+\end{caml_example}
+
+\begin{caml_example}{toplevel}
+Format.printf "Hello@.";
+print_endline "world";;
+\end{caml_example}
(* TEST
reference="${test_source_directory}/redirections.reference"
output="redirections.output"
+ files="${test_source_directory}/redirections.input"
script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}"
+ -repo-root ${ocamlsrcdir} ${files} -o ${output}"
* hasstr
** native-compiler
*** shared-libraries
*** no-shared-libraries
**** script with unix,str
script = "${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}"
+ -repo-root ${ocamlsrcdir} ${files} -o ${output}"
***** check-program-output
*)
-
-\begin{caml_example}{toplevel}
-[@@@warning "+A"];;
-1 + 2. [@@expect error];;
-let f x = () [@@expect warning 27];;
-\end{caml_example}
-
-\begin{caml_example}{toplevel}
-Format.printf "Hello@.";
-print_endline "world";;
-\end{caml_example}
-(* TEST
- reference="${test_source_directory}/redirections.reference"
- output="redirections.output"
- script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}"
- * hasstr
- ** native-compiler
- *** shared-libraries
- **** script with unix,str
- ***** check-program-output
- *** no-shared-libraries
- **** script with unix,str
- script = "${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}"
- ***** check-program-output
-*)
+\begin{camlexample}{toplevel}
+\begin{caml}
+\begin{camlinput}
+$\?$[@@@warning "+A"];;
+\end{camlinput}
+\end{caml}
+\begin{caml}
+\begin{camlinput}
+$\?$1 + <<2.>> ;;
+\end{camlinput}
+\begin{camlerror}
+$\:$Error: This expression has type float but an expression was expected of type
+$\:$ int
+\end{camlerror}
+\end{caml}
+\begin{caml}
+\begin{camlinput}
+$\?$let f <<x>> = () ;;
+\end{camlinput}
+\begin{camlwarn}
+$\:$Warning 27: unused variable x.
+$\:$val f : 'a -> unit = <fun>
+\end{camlwarn}
+\end{caml}
+\end{camlexample}
-\camlexample{toplevel}
-\caml\camlinput\?[@@@warning "+A"];;
-\endcamlinput\endcaml
-\caml\camlinput\?1 + \<2.\> ;;
-\endcamlinput\camlerror\:Error: This expression has type float but an expression was expected of type
-\: int
-\endcamlerror\endcaml
-\caml\camlinput\?let f \<x\> = () ;;
-\endcamlinput\camlwarn\:Warning 27: unused variable x.
-\:val f : \textquotesingle\-a -> unit = <fun>
-\endcamlwarn\endcaml
-\endcamlexample
-
-\camlexample{toplevel}
-\caml\camlinput\?Format.printf "Hello@.";
-\?print_endline "world";;
-\endcamlinput\camloutput\:Hello
-\:world
-\:- : unit = ()
-\endcamloutput\endcaml
-\endcamlexample
+\begin{camlexample}{toplevel}
+\begin{caml}
+\begin{camlinput}
+$\?$Format.printf "Hello@.";
+$\?$print_endline "world";;
+\end{camlinput}
+\begin{camloutput}
+$\:$Hello
+$\:$world
+$\:$- : unit = ()
+\end{camloutput}
+\end{caml}
+\end{camlexample}
+++ /dev/null
-debuggee.ml
--- /dev/null
+Loading program... done.
+hello host
+
+Module(s) Plugin loaded.
+Breakpoint: 1
+2 <|b|>print_endline "hello plugin"
+Backtrace:
+#0 Plugin plugin.ml:2:3
+#1 Plugin plugin.ml:4:10
+hello plugin
+Program exit.
--- /dev/null
+(* TEST
+
+include dynlink
+files = "host.ml plugin.ml"
+libraries = ""
+
+flags += " -g "
+ocamldebug_script = "${test_source_directory}/input_script"
+
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+module = "host.ml"
+***** ocamlc.byte
+module = "plugin.ml"
+****** ocamlc.byte
+module = ""
+all_modules = "host.cmo"
+program = "${test_build_directory}/host.byte"
+libraries = "dynlink"
+
+******* run
+output = "host.output"
+******** check-program-output
+reference = "${test_source_directory}/host.reference"
+
+******** ocamldebug
+output = "host.debug.output"
+********* check-program-output
+reference = "${test_source_directory}/host.debug.reference"
+
+*)
+
+let () = print_endline "hello host"; Dynlink.loadfile "plugin.cmo"
--- /dev/null
+hello host
+hello plugin
--- /dev/null
+r
+br @ Plugin 2
+r
+bt
+r
--- /dev/null
+let do_plugin () =
+ print_endline "hello plugin"
+
+let () = do_plugin ()
+++ /dev/null
-debuggee.ml
+++ /dev/null
-debuggee.ml
+++ /dev/null
-clean_typer.ml
%{
open Syntax
open Gram_aux
+
+(* test f' '"' *)
+let () =
+ let f' = ignore in
+ f' '"'
%}
%token <string> Tident
+++ /dev/null
-main.ml
-mpr7760.mll
-chars.mll
+++ /dev/null
-success.ml
-failure.ml
-typeonly.ml
+++ /dev/null
-t000.ml
-t010-const0.ml
-t010-const1.ml
-t010-const2.ml
-t010-const3.ml
-t011-constint.ml
-t020.ml
-t021-pushconst1.ml
-t021-pushconst2.ml
-t021-pushconst3.ml
-t022-pushconstint.ml
-t040-makeblock1.ml
-t040-makeblock2.ml
-t040-makeblock3.ml
-t041-makeblock.ml
-t050-getglobal.ml
-t050-pushgetglobal.ml
-t051-getglobalfield.ml
-t051-pushgetglobalfield.ml
-t060-raise.ml
-t070-branchif.ml
-t070-branchifnot.ml
-t070-branch.ml
-t071-boolnot.ml
-t080-eq.ml
-t080-geint.ml
-t080-gtint.ml
-t080-leint.ml
-t080-ltint.ml
-t080-neq.ml
-t090-acc0.ml
-t090-acc1.ml
-t090-acc2.ml
-t090-acc3.ml
-t090-acc4.ml
-t090-acc5.ml
-t090-acc6.ml
-t090-acc7.ml
-t091-acc.ml
-t092-pushacc0.ml
-t092-pushacc1.ml
-t092-pushacc2.ml
-t092-pushacc3.ml
-t092-pushacc4.ml
-t092-pushacc5.ml
-t092-pushacc6.ml
-t092-pushacc7.ml
-t092-pushacc.ml
-t093-pushacc.ml
-t100-pushtrap.ml
-t101-poptrap.ml
-t110-addint.ml
-t110-andint.ml
-t110-asrint-1.ml
-t110-asrint-2.ml
-t110-divint-1.ml
-t110-divint-2.ml
-t110-divint-3.ml
-t110-lslint.ml
-t110-lsrint.ml
-t110-modint-1.ml
-t110-modint-2.ml
-t110-mulint.ml
-t110-negint.ml
-t110-offsetint.ml
-t110-orint.ml
-t110-subint.ml
-t110-xorint.ml
-t120-getstringchar.ml
-t121-setstringchar.ml
-t130-getvectitem.ml
-t130-vectlength.ml
-t131-setvectitem.ml
-t140-switch-1.ml
-t140-switch-2.ml
-t140-switch-3.ml
-t140-switch-4.ml
-t141-switch-5.ml
-t141-switch-6.ml
-t141-switch-7.ml
-t142-switch-8.ml
-t142-switch-9.ml
-t142-switch-A.ml
-t150-push-1.ml
-t150-push-2.ml
-t160-closure.ml
-t161-apply1.ml
-t162-return.ml
-t163.ml
-t164-apply2.ml
-t164-apply3.ml
-t165-apply.ml
-t170-envacc2.ml
-t170-envacc3.ml
-t170-envacc4.ml
-t171-envacc.ml
-t172-pushenvacc1.ml
-t172-pushenvacc2.ml
-t172-pushenvacc3.ml
-t172-pushenvacc4.ml
-t173-pushenvacc.ml
-t180-appterm1.ml
-t180-appterm2.ml
-t180-appterm3.ml
-t181-appterm.ml
-t190-makefloatblock-1.ml
-t190-makefloatblock-2.ml
-t190-makefloatblock-3.ml
-t191-vectlength.ml
-t192-getfloatfield-1.ml
-t192-getfloatfield-2.ml
-t193-setfloatfield-1.ml
-t193-setfloatfield-2.ml
-t200-getfield0.ml
-t200-getfield1.ml
-t200-getfield2.ml
-t200-getfield3.ml
-t201-getfield.ml
-t210-setfield0.ml
-t210-setfield1.ml
-t210-setfield2.ml
-t210-setfield3.ml
-t211-setfield.ml
-t220-assign.ml
-t230-check_signals.ml
-t240-c_call1.ml
-t240-c_call2.ml
-t240-c_call3.ml
-t240-c_call4.ml
-t240-c_call5.ml
-t250-closurerec-1.ml
-t250-closurerec-2.ml
-t251-pushoffsetclosure0.ml
-t251-pushoffsetclosure2.ml
-t251-pushoffsetclosurem2.ml
-t252-pushoffsetclosure.ml
-t253-offsetclosure0.ml
-t253-offsetclosure2.ml
-t253-offsetclosurem2.ml
-t254-offsetclosure.ml
-t260-offsetref.ml
-t270-push_retaddr.ml
-t300-getmethod.ml
-t301-object.ml
-t310-alloc-1.ml
-t310-alloc-2.ml
-t320-gc-1.ml
-t320-gc-2.ml
-t320-gc-3.ml
-t330-compact-1.ml
-t330-compact-2.ml
-t330-compact-3.ml
-t330-compact-4.ml
-t340-weak.ml
-t350-heapcheck.ml
-t360-stacks-1.ml
-t360-stacks-2.ml
+++ /dev/null
-compat32.ml
+++ /dev/null
-tool-ocamlc-open.ml
+++ /dev/null
-stop_after_parsing_impl.ml
-stop_after_parsing_intf.mli
-stop_after_typing_impl.ml
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
<div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
<span class="keyword">-></span> <code class="type"><a href="Inline_records.html#TYPEany">any</a></code></code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</pre>
<pre><code><span class="keyword">type</span> <code class="type"></code><a href="Inline_records.html#TYPEext">ext</a> += </code></pre><table class="typetable">
<tr>
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
</div>
</td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
Module
.BI "Inline_records"
:
-.B sig end
+.B sig end
.sp
This test focuses on the printing of documentation for inline record
lbl :
.B int
; (* Field documentation for non\-inline,
-.B lbl : int
+.ft B
+lbl : int
+.ft R
*)
more :
.B int list
; (* More documentation for r,
-.B more : int list
+.ft B
+more : int list
+.ft R
*)
}
lbl :
.B int
; (*
-.B A
+.ft B
+A
+.ft R
field documentation
*)
more :
.B int list
; (* More
-.B A
+.ft B
+A
+.ft R
field documentation
*)
}
a_label_for_B :
.B int
; (*
-.B B
+.ft B
+B
+.ft R
field documentation
*)
more_label_for_B :
.B int list
; (* More
-.B B
+.ft B
+B
+.ft R
field documentation
*)
}
c_has_label_too :
.B float
; (*
-.B C
+.ft B
+C
+.ft R
field documentation
*)
more_than_one :
any :
.B 'a
; (*
-.B A
+.ft B
+A
+.ft R
field
-.B any:\&'a
+.ft B
+any:\&'a
+.ft R
for
-.B D
+.ft B
+D
+.ft R
in
-.B any
+.ft B
+any
+.ft R
\&.
*)
}
name :
.B string
; (* Error field documentation
-.B name:string
+.ft B
+name:string
+.ft R
*)
}
yet_another_field :
.B unit
; (* Field documentation for
-.B E
+.ft B
+E
+.ft R
in ext
*)
}
even_more :
.B int -> int
; (* Some field documentations for
-.B F
+.ft B
+F
+.ft R
*)
}
<code><span id="TYPEELTb.field">field</span> : <code class="type">'a</code>;</code></td>
</tr></table>
-}
+<code>}</code>
<code><span id="TYPEELTLinebreaks.E.inline">inline</span> : <code class="type">int</code>;</code></td>
</tr></table>
-}
+<code>}</code>
</pre>
<p>type_Linebreaks.html should contain</p>
<code><span id="TYPEELTVariants.A.x">x</span> : <code class="type">int</code>;</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
<code><span id="TYPEELTVariants.B.y">y</span> : <code class="type">int</code>;</code></td>
</tr></table>
-}
+<code>}</code>
</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
+++ /dev/null
-Documentation_tags.mli
-Extensible_variant.ml
-Include_module_type_of.mli
-Inline_records.mli
-Inline_records_bis.ml
-Item_ids.mli
-Paragraph.mli
-Module_whitespace.ml
-No_preamble.mli
-latex_ref.mli
-Level_0.mli
-Linebreaks.mli
-Loop.ml
-Short_description.txt
-t01.ml
-t02.ml
-t03.ml
-t04.ml
-t05.ml
-Test.mli
-Variants.mli
#
# module T01:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
-<[sig end]>
+<[sig end]>
#
# module T01.M:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
<[sig val y : int end]>
#
# module type T01.MT:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
<[sig
type t =
#
# module T04:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
-<[sig end]>
+<[sig end]>
#
# module T04.A:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
<[sig type a = A of { lbl : int; } end]>
# type T04.A.a:
#
# module type T04.E:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
<[sig exception E of { lbl : int; } end]>
#
# module T04.E_bis:
# Odoc_info.string_of_module_type:
-<[sig end]>
+<[sig end]>
# Odoc_info.string_of_module_type ~complete: true :
<[sig exception E of { lbl : int; } end]>
<span class="keyword">type</span> s = ..<br>
<span class="keyword">type</span> s += <span class="constructor">B</span><br>
<span class="keyword">val</span> x : <span class="constructor">Linebreaks</span>.a<br>
- <span class="keyword">module</span> <span class="constructor">S</span> : <span class="keyword">sig</span> <span class="keyword">module</span> <span class="constructor">I</span> : <span class="keyword">sig</span> <span class="keyword">end</span> <span class="keyword">end</span><br>
- <span class="keyword">module</span> <span class="keyword">type</span> s = <span class="keyword">sig</span> <span class="keyword">end</span><br>
+ <span class="keyword">module</span> <span class="constructor">S</span> : <span class="keyword">sig</span> <span class="keyword">module</span> <span class="constructor">I</span> : <span class="keyword">sig</span> <span class="keyword">end</span> <span class="keyword">end</span><br>
+ <span class="keyword">module</span> <span class="keyword">type</span> s = <span class="keyword">sig</span> <span class="keyword">end</span><br>
<span class="keyword">class</span> <span class="keyword">type</span> d = <span class="keyword">object</span> <span class="keyword">end</span><br>
<span class="keyword">exception</span> <span class="constructor">E</span> <span class="keyword">of</span> { inline : int; }<br>
<span class="keyword">end</span></code></body></html>
+++ /dev/null
-question.ml
4 | 2)...
Error: This expression has type int but an expression was expected of type
float
+Line 2, characters 12-17:
+2 | let x = 1 + "abc" in
+ ^^^^^
+Error: This expression has type string but an expression was expected of type
+ int
File "error_highlighting_use1.ml", line 1, characters 8-15:
1 | let x = (1 + 2) +. 3. in ();;
^^^^^^^
2) +.
3. in ();;
+let x = 1 + "abc" in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in ();;
+
#use "error_highlighting_use1.ml";;
#use "error_highlighting_use2.ml";;
#use "error_highlighting_use3.ml";;
+++ /dev/null
-exotic_lists.ml
-pr6468.ml
-pr7060.ml
-pr7751.ml
-strings.ml
-tracing.ml
-error_highlighting.ml
-uncaught_exceptions.ml
Exception: Not_found.
Raised at file "//toplevel//", line 2, characters 17-26
Called from file "//toplevel//", line 1, characters 11-15
-Called from file "toplevel/toploop.ml", line 208, characters 17-27
+Called from file "toplevel/toploop.ml", line 212, characters 17-27
--- /dev/null
+module Empty : sig end
+type u = A
+type v = B
+module type S = sig end
+val m : (module S) = <module>
+module M : sig type 'a t = X of 'a end
+val x : (u * v * (module S)) M.t = M.X (A, B, <module>)
+module type S = sig end
+val m : (module S) = <module>
+type u = A
+type v = B
+module M : sig type 'a t = X of 'a end
+val y : (u * v * (module S)) M.t = M.X (A, B, <module>)
+Line 2, characters 4-5:
+2 | x = y;;
+ ^
+Error: This expression has type (u/1 * v/1 * (module S/1)) M/1.t
+ but an expression was expected of type
+ (u/2 * v/2 * (module S/2)) M/2.t
+ Hint: The types v and u have been defined multiple times in this
+ toplevel session. Some toplevel values still refer to old versions
+ of those types. Did you try to redefine them?
+ Hint: The module M has been defined multiple times in this toplevel
+ session. Some toplevel values still refer to old versions of this
+ module. Did you try to redefine them?
+ Hint: The module type S has been defined multiple times in this
+ toplevel session. Some toplevel values still refer to old versions
+ of this module type. Did you try to redefine them?
+type a = A
+val a : a = A
+type a = A
+val b : a = A
+Line 2, characters 4-5:
+2 | a = b;;
+ ^
+Error: This expression has type a/1 but an expression was expected of type
+ a/2
+ Hint: The type a has been defined multiple times in this toplevel
+ session. Some toplevel values still refer to old versions of this
+ type. Did you try to redefine them?
--- /dev/null
+(* TEST
+ * toplevel
+*)
+
+(* This is a toplevel test to trigger toplevel specific hints *)
+
+
+module Empty = struct end
+
+
+type u = A
+type v = B
+module type S = sig end
+let m = (module Empty:S)
+
+module M = struct
+ type 'a t = X of 'a
+end
+let x =M.X (A,B,m);;
+
+module type S = sig end
+let m = (module Empty:S)
+
+type u = A
+type v = B
+module M = struct
+ type 'a t = X of 'a
+end
+let y = M.X (A,B,m);;
+
+x = y;;
+
+type a = A
+let a = A;;
+
+type a = A
+let b = A;;
+
+a = b;;
+exit 0;;
+++ /dev/null
-array_spec.ml
-comparison_table.ml
-module_coercion.ml
-ref_spec.ml
-locs.ml
+++ /dev/null
-missing_rec_hint.ml
-unit_fun_hints.ml
-type_expected_explanation.ml
-repeated_did_you_mean.ml
-const_int_hint.ml
open D
;;
[%%expect{|
-module D : sig end
+module D : sig end
Line 3, characters 5-6:
3 | open D
^
8 | [@@@ocaml.ppwarning "Pp warning2!"]
^^^^^^^^^^^^^^
Warning 22: Pp warning2!
-module X : sig end
+module X : sig end
|}]
let x =
+++ /dev/null
-deprecated.ml
-alerts.ml
type ('a, 'b) bar += A of float
is not included in
type ('a, 'b) bar += A of int
- The types for field A are not equal.
+ Constructors do not match:
+ A of float
+ is not compatible with:
+ A of int
+ The types are not equal.
|}]
module M : sig
type ('a, 'b) bar += A of 'b
is not included in
type ('a, 'b) bar += A of 'a
- The types for field A are not equal.
+ Constructors do not match:
+ A of 'b
+ is not compatible with:
+ A of 'a
+ The types are not equal.
|}]
+module M : sig
+ type ('a, 'b) bar = A of 'a
+end = struct
+ type ('b, 'a) bar = A of 'a
+end;;
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type ('b, 'a) bar = A of 'a
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type ('b, 'a) bar = A of 'a end
+ is not included in
+ sig type ('a, 'b) bar = A of 'a end
+ Type declarations do not match:
+ type ('b, 'a) bar = A of 'a
+ is not included in
+ type ('a, 'b) bar = A of 'a
+ Constructors do not match:
+ A of 'a
+ is not compatible with:
+ A of 'a
+ The types are not equal.
+|}];;
+
+
module M : sig
type ('a, 'b) bar += A : 'c -> ('c, 'd) bar
end = struct
type ('a, 'b) bar += A : 'd -> ('c, 'd) bar
is not included in
type ('a, 'b) bar += A : 'c -> ('c, 'd) bar
- The types for field A are not equal.
+ Constructors do not match:
+ A : 'd -> ('c, 'd) bar
+ is not compatible with:
+ A : 'c -> ('c, 'd) bar
+ The types are not equal.
|}]
(* Extensions can be rebound *)
+++ /dev/null
-cast.ml
-extensions.ml
-msg.ml
-open_types.ml
+++ /dev/null
-fstclassmod.ml
representative for an ambivalent type escaping its scope.
The commit that was implemented poses problems of its own: we are now
unifying the type of the patterns in the environment of each pattern, instead
- of the outter one. The code discussed in PR#7617 passes because each branch
+ of the outer one. The code discussed in PR#7617 passes because each branch
contains the same equation, but consider the following cases: *)
let f (type a b) (x : (a, b) eq) =
+++ /dev/null
-ambiguity.ml
-didier.ml
-dynamic_frisch.ml
-nested_equations.ml
-omega07.ml
-or_patterns.ml
-pr5332.ml
-pr5689.ml
-pr5785.ml
-pr5848.ml
-pr5906.ml
-pr5948.ml
-pr5981.ml
-pr5985.ml
-pr5989.ml
-pr5997.ml
-pr6158.ml
-pr6163.ml
-pr6174.ml
-pr6241.ml
-pr6690.ml
-pr6817.ml
-pr6934.ml
-pr6980.ml
-pr6993_bad.ml
-pr7016.ml
-pr7160.ml
-pr7214.ml
-pr7222.ml
-pr7230.ml
-pr7234.ml
-pr7260.ml
-pr7269.ml
-pr7298.ml
-pr7374.ml
-pr7378.ml
-pr7381.ml
-pr7390.ml
-pr7391.ml
-pr7397.ml
-pr7421.ml
-pr7432.ml
-pr7618.ml
-pr7747.ml
-term-conv.ml
-test.ml
-unexpected_existentials.ml
-unify_mb.ml
-variables_in_mcomp.ml
-yallop_bugs.ml
but an expression was expected of type a inline_t
Type 'a = [< `Link | `Nonlink > `Nonlink ] is not compatible with type
a = [< `Link | `Nonlink ]
- Types for tag `Nonlink are incompatible
+ The second variant type is bound to $'a,
+ it may not allow the tag(s) `Nonlink
|}];;
module M :
functor (A : sig module type T end) (B : sig module type T end) ->
sig val f : ((module A.T), (module B.T)) t -> string end
-module A : sig module type T = sig end end
+module A : sig module type T = sig end end
module N : sig val f : ((module A.T), (module A.T)) t -> string end
Exception: Match_failure ("", 8, 52).
|}];;
^^
Error: This expression has type [< `Bar | `Foo > `Bar ]
but an expression was expected of type [< `Bar | `Foo ]
- Types for tag `Bar are incompatible
+ The second variant type is bound to $Aux,
+ it may not allow the tag(s) `Bar
|}];;
4 | type 'a tt = 'a t =
5 | Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt..
Error: This variant or record definition does not match that of type 'a t
- The types for field Same are not equal.
+ Constructors do not match:
+ Same : 'l t -> 'l t
+ is not compatible with:
+ Same : 'l1 t -> 'l2 t
+ The types are not equal.
|}];;
2 | ..type t = X.t =
3 | | A : 'a * 'b * ('b -> unit) -> t
Error: This variant or record definition does not match that of type X.t
- The types for field A are not equal.
+ Constructors do not match:
+ A : 'a * 'b * ('a -> unit) -> X.t
+ is not compatible with:
+ A : 'a * 'b * ('b -> unit) -> X.t
+ The types are not equal.
|}]
(* would segfault
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* #9012 by Thomas Refis *)
+
+type ab = A | B
+
+module M : sig
+ type mab = A | B
+ type _ t = AB : ab t | MAB : mab t
+ val ab : mab t
+end = struct
+ type mab = ab = A | B
+ type _ t = AB : ab t | MAB : mab t
+ let ab = AB
+end
+[%%expect{|
+type ab = A | B
+module M :
+ sig type mab = A | B type _ t = AB : ab t | MAB : mab t val ab : mab t end
+|}]
+
+open M
+
+let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+ match t1, t2, x with
+ | AB, AB, A -> 1
+ | MAB, _, A -> 2
+ | _, AB, B -> 3
+ | _, MAB, B -> 4
+[%%expect{|
+Lines 4-8, characters 2-18:
+4 | ..match t1, t2, x with
+5 | | AB, AB, A -> 1
+6 | | MAB, _, A -> 2
+7 | | _, AB, B -> 3
+8 | | _, MAB, B -> 4
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(AB, MAB, A)
+val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
+|}]
+
+let () = ignore (f M.ab MAB A)
+[%%expect{|
+Exception: Match_failure ("", 4, 2).
+|}]
+
+(* variant *)
+
+type _ ab = A | B
+
+module M : sig
+ type _ mab
+ type _ t = AB : unit ab t | MAB : unit mab t
+ val ab : unit mab t
+ val a : 'a mab
+ val b : 'a mab
+end = struct
+ type 'a mab = 'a ab = A | B
+ type _ t = AB : unit ab t | MAB : unit mab t
+ let ab = AB
+ let a = A
+ let b = B
+end;;
+[%%expect{|
+type _ ab = A | B
+module M :
+ sig
+ type _ mab
+ type _ t = AB : unit ab t | MAB : unit mab t
+ val ab : unit mab t
+ val a : 'a mab
+ val b : 'a mab
+ end
+|}]
+
+open M
+
+(* The second clause isn't redundant *)
+let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+ match t1, t2, x with
+ | AB, AB, A -> 1
+ | _, AB, A -> 2
+ | _, AB, B -> 3
+ | _, MAB, _ -> 4;;
+[%%expect{|
+val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
+|}]
+
+(* the answer shouldn't be 3 *)
+let x = f MAB M.ab M.a;;
+[%%expect{|
+val x : int = 2
+|}]
+
+(* using records *)
+
+type ab = { a : int }
+
+module M : sig
+ type mab = { a : int }
+
+ type _ t = AB : ab t | MAB : mab t
+
+ val a : mab
+ val ab : mab t
+end = struct
+ type mab = ab = { a : int }
+
+ type _ t = AB : ab t | MAB : mab t
+
+ let a = { a = 42 }
+ let ab = AB
+end;;
+[%%expect{|
+type ab = { a : int; }
+module M :
+ sig
+ type mab = { a : int; }
+ type _ t = AB : ab t | MAB : mab t
+ val a : mab
+ val ab : mab t
+ end
+|}]
+
+open M
+
+let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+ match t1, t2, x with
+ | AB, AB, { a = _ } -> 1
+ | MAB, _, { a = _ } -> 2
+ | _, AB, { a = _ } -> 3
+ | _, MAB, { a = _ } -> 4;;
+[%%expect{|
+Line 7, characters 4-22:
+7 | | _, AB, { a = _ } -> 3
+ ^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
+|}]
+
+let p = f M.ab MAB { a = 42 };;
+[%%expect{|
+val p : int = 4
+|}]
+
+
+(* #9019 by Leo White *)
+
+type _ a_or_b =
+ A_or_B : [< `A of string | `B of int] a_or_b
+
+type _ a =
+ | A : [> `A of string] a
+ | Not_A : _ a
+
+let f (type x) (a : x a) (a_or_b : x a_or_b) (x : x) =
+ match a, a_or_b, x with
+ | Not_A, A_or_B, `B i -> print_int i
+ | _, A_or_B, `A s -> print_string s
+[%%expect{|
+type _ a_or_b = A_or_B : [< `A of string | `B of int ] a_or_b
+type _ a = A : [> `A of string ] a | Not_A : 'a a
+Lines 9-11, characters 2-37:
+ 9 | ..match a, a_or_b, x with
+10 | | Not_A, A_or_B, `B i -> print_int i
+11 | | _, A_or_B, `A s -> print_string s
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(A, A_or_B, `B _)
+val f : 'x a -> 'x a_or_b -> 'x -> unit = <fun>
+|}]
+
+let segfault = f A A_or_B (`B 0)
+[%%expect{|
+Exception: Match_failure ("", 9, 2).
+|}]
+
+
+(* Another example *)
+type (_, _) b =
+ | A : ([< `A ], 'a) b
+ | B : ([< `B of 'a], 'a) b
+
+type _ ty =
+ | String_option : string option ty
+
+let f (type x) (type y) (b : (x, y ty) b) (x : x) (y : y) =
+ match b, x, y with
+ | B, `B String_option, Some s -> print_string s
+ | A, `A, _ -> ()
+[%%expect{|
+type (_, _) b = A : ([< `A ], 'a) b | B : ([< `B of 'a ], 'a) b
+type _ ty = String_option : string option ty
+Lines 9-11, characters 2-18:
+ 9 | ..match b, x, y with
+10 | | B, `B String_option, Some s -> print_string s
+11 | | A, `A, _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(B, `B String_option, None)
+val f : ('x, 'y ty) b -> 'x -> 'y -> unit = <fun>
+|}]
+
+let segfault = f B (`B String_option) None
+[%%expect{|
+Exception: Match_failure ("", 9, 2).
+|}]
+
+(* More polymorphic variants *)
+
+type 'a a = private [< `A of 'a];;
+let f (x : _ a) = match x with `A None -> ();;
+[%%expect{|
+type 'a a = private [< `A of 'a ]
+Line 2, characters 18-44:
+2 | let f (x : _ a) = match x with `A None -> ();;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`A (Some _)
+val f : 'a option a -> unit = <fun>
+|}]
+
+let f (x : [> `A] a) = match x with `A `B -> ();;
+[%%expect{|
+Line 1, characters 23-47:
+1 | let f (x : [> `A] a) = match x with `A `B -> ();;
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`A `A
+val f : [< `A | `B > `A ] a -> unit = <fun>
+|}]
Line 2, characters 2-31:
2 | type t = string [@@immediate]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Types marked with the immediate attribute must be
- non-pointer types like int or bool
+Error: Types marked with the immediate attribute must be non-pointer types
+ like int or bool.
|}];;
(* Not guaranteed that t is immediate, so this is an invalid declaration *)
Line 3, characters 2-26:
3 | type s = t [@@immediate]
^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Types marked with the immediate attribute must be
- non-pointer types like int or bool
+Error: Types marked with the immediate attribute must be non-pointer types
+ like int or bool.
|}];;
(* Can't ascribe to an immediate type signature with a non-immediate type *)
type t = string
is not included in
type t [@@immediate]
- the first is not an immediate type.
+ The first is not an immediate type.
|}];;
(* Same as above but with explicit signature *)
type t = string
is not included in
type t [@@immediate]
- the first is not an immediate type.
+ The first is not an immediate type.
|}];;
(* Can't use a non-immediate type even if mutually recursive *)
Line 2, characters 2-26:
2 | type t = s [@@immediate]
^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Types marked with the immediate attribute must be
- non-pointer types like int or bool
+Error: Types marked with the immediate attribute must be non-pointer types
+ like int or bool.
|}];;
+++ /dev/null
-immediate.ml
(* TEST
- * toplevel
+ * expect
*)
(*
(* Use a module pattern *)
let sort (type s) (module Set : Set.S with type elt = s) l =
Set.elements (List.fold_right Set.add l Set.empty)
+;;
+[%%expect{|
+val sort : (module Set.S with type elt = 's) -> 's list -> 's list = <fun>
+|}];;
(* No real improvement here? *)
let make_set (type s) cmp : (module Set.S with type elt = s) =
(module Set.Make (struct type t = s let compare = cmp end))
+;;
+[%%expect{|
+val make_set : ('s -> 's -> int) -> (module Set.S with type elt = 's) = <fun>
+|}];;
(* No type annotation here *)
let sort_cmp (type s) cmp =
sort (module Set.Make (struct type t = s let compare = cmp end))
+;;
+[%%expect{|
+val sort_cmp : ('s -> 's -> int) -> 's list -> 's list = <fun>
+|}];;
module type S = sig type t val x : t end;;
+[%%expect{|
+module type S = sig type t val x : t end
+|}];;
+
let f (module M : S with type t = int) = M.x;;
+[%%expect{|
+val f : (module S with type t = int) -> int = <fun>
+|}];;
+
let f (module M : S with type t = 'a) = M.x;; (* Error *)
+[%%expect{|
+Line 1, characters 6-37:
+1 | let f (module M : S with type t = 'a) = M.x;; (* Error *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type of this packed module contains variables:
+ (module S with type t = 'a)
+|}];;
+
let f (type a) (module M : S with type t = a) = M.x;;
f (module struct type t = int let x = 1 end);;
+[%%expect{|
+val f : (module S with type t = 'a) -> 'a = <fun>
+- : int = 1
+|}];;
+
+(***)
type 'a s = {s: (module S with type t = 'a)};;
+[%%expect{|
+type 'a s = { s : (module S with type t = 'a); }
+|}];;
+
{s=(module struct type t = int let x = 1 end)};;
+[%%expect{|
+- : int s = {s = <module>}
+|}];;
+
let f {s=(module M)} = M.x;; (* Error *)
+[%%expect{|
+Line 1, characters 9-19:
+1 | let f {s=(module M)} = M.x;; (* Error *)
+ ^^^^^^^^^^
+Error: The type of this packed module contains variables:
+ (module S with type t = 'a)
+|}];;
+
let f (type a) ({s=(module M)} : a s) = M.x;;
+[%%expect{|
+val f : 'a s -> 'a = <fun>
+|}];;
type s = {s: (module S with type t = int)};;
let f {s=(module M)} = M.x;;
let f {s=(module M)} {s=(module N)} = M.x + N.x;;
+[%%expect{|
+type s = { s : (module S with type t = int); }
+val f : s -> int = <fun>
+val f : s -> s -> int = <fun>
+|}];;
+
+(***)
module type S = sig val x : int end;;
+[%%expect{|
+module type S = sig val x : int end
+|}];;
+
let f (module M : S) y (module N : S) = M.x + y + N.x;;
+[%%expect{|
+val f : (module S) -> int -> (module S) -> int = <fun>
+|}];;
+
let m = (module struct let x = 3 end);; (* Error *)
+[%%expect{|
+Line 1, characters 8-37:
+1 | let m = (module struct let x = 3 end);; (* Error *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The signature for this packaged module couldn't be inferred.
+|}];;
+
let m = (module struct let x = 3 end : S);;
+[%%expect{|
+val m : (module S) = <module>
+|}];;
+
f m 1 m;;
+[%%expect{|
+- : int = 7
+|}];;
f m 1 (module struct let x = 2 end);;
+[%%expect{|
+- : int = 6
+|}];;
+
+(***)
let (module M) = m in M.x;;
+[%%expect{|
+- : int = 3
+|}];;
+
let (module M) = m;; (* Error: only allowed in [let .. in] *)
+[%%expect{|
+Line 1, characters 4-14:
+1 | let (module M) = m;; (* Error: only allowed in [let .. in] *)
+ ^^^^^^^^^^
+Error: Modules are not allowed in this pattern.
+|}];;
+
class c = let (module M) = m in object end;; (* Error again *)
+[%%expect{|
+Line 1, characters 14-24:
+1 | class c = let (module M) = m in object end;; (* Error again *)
+ ^^^^^^^^^^
+Error: Modules are not allowed in this pattern.
+|}];;
+
module M = (val m);;
+[%%expect{|
+module M : S
+|}];;
+
+(***)
module type S' = sig val f : int -> int end;;
+[%%expect{|
+module type S' = sig val f : int -> int end
+|}];;
+
(* Even works with recursion, but must be fully explicit *)
let rec (module M : S') =
(module struct let f n = if n <= 0 then 1 else n * M.f (n-1) end : S')
in M.f 3;;
+[%%expect{|
+- : int = 6
+|}];;
(* Subtyping *)
module type S = sig type t type u val x : t * u end
+
let f (l : (module S with type t = int and type u = bool) list) =
(l :> (module S with type u = bool) list)
+;;
+[%%expect{|
+module type S = sig type t type u val x : t * u end
+val f :
+ (module S with type t = int and type u = bool) list ->
+ (module S with type u = bool) list = <fun>
+|}];;
(* GADTs from the manual *)
(* the only modification is in to_string *)
| Pair (module P) ->
let (x1, x2) = TypEq.apply P.eq x in
Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
+;;
+[%%expect{|
+module TypEq :
+ sig
+ type ('a, 'b) t
+ val apply : ('a, 'b) t -> 'a -> 'b
+ val refl : ('a, 'a) t
+ val sym : ('a, 'b) t -> ('b, 'a) t
+ end
+module rec Typ :
+ sig
+ module type PAIR =
+ sig
+ type t
+ and t1
+ and t2
+ val eq : (t, t1 * t2) TypEq.t
+ val t1 : t1 Typ.typ
+ val t2 : t2 Typ.typ
+ end
+ type 'a typ =
+ Int of ('a, int) TypEq.t
+ | String of ('a, string) TypEq.t
+ | Pair of (module PAIR with type t = 'a)
+ end
+val int : int Typ.typ = Typ.Int <abstr>
+val str : string Typ.typ = Typ.String <abstr>
+val pair : 's1 Typ.typ -> 's2 Typ.typ -> ('s1 * 's2) Typ.typ = <fun>
+val to_string : 'a Typ.typ -> 'a -> string = <fun>
+|}];;
(* Wrapping maps *)
module type MapT = sig
let of_t x = x
let to_t x = x
end
+;;
+[%%expect{|
+module type MapT =
+ sig
+ type key
+ type +'a t
+ val empty : 'a t
+ val is_empty : 'a t -> bool
+ val mem : key -> 'a t -> bool
+ val add : key -> 'a -> 'a t -> 'a t
+ val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+ val singleton : key -> 'a -> 'a t
+ val remove : key -> 'a t -> 'a t
+ val merge :
+ (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+ val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+ val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ val for_all : (key -> 'a -> bool) -> 'a t -> bool
+ val exists : (key -> 'a -> bool) -> 'a t -> bool
+ val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+ val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+ val cardinal : 'a t -> int
+ val bindings : 'a t -> (key * 'a) list
+ val min_binding : 'a t -> key * 'a
+ val min_binding_opt : 'a t -> (key * 'a) option
+ val max_binding : 'a t -> key * 'a
+ val max_binding_opt : 'a t -> (key * 'a) option
+ val choose : 'a t -> key * 'a
+ val choose_opt : 'a t -> (key * 'a) option
+ val split : key -> 'a t -> 'a t * 'a option * 'a t
+ val find : key -> 'a t -> 'a
+ val find_opt : key -> 'a t -> 'a option
+ val find_first : (key -> bool) -> 'a t -> key * 'a
+ val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
+ val find_last : (key -> bool) -> 'a t -> key * 'a
+ val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+ val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+ val of_seq : (key * 'a) Seq.t -> 'a t
+ type data
+ type map
+ val of_t : data t -> map
+ val to_t : map -> data t
+ end
+type ('k, 'd, 'm) map =
+ (module MapT with type data = 'd and type key = 'k and type map = 'm)
+val add : ('k, 'd, 'm) map -> 'k -> 'd -> 'm -> 'm = <fun>
+module SSMap :
+ sig
+ type key = String.t
+ type 'a t = 'a Map.Make(String).t
+ val empty : 'a t
+ val is_empty : 'a t -> bool
+ val mem : key -> 'a t -> bool
+ val add : key -> 'a -> 'a t -> 'a t
+ val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+ val singleton : key -> 'a -> 'a t
+ val remove : key -> 'a t -> 'a t
+ val merge :
+ (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+ val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+ val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ val for_all : (key -> 'a -> bool) -> 'a t -> bool
+ val exists : (key -> 'a -> bool) -> 'a t -> bool
+ val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+ val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+ val cardinal : 'a t -> int
+ val bindings : 'a t -> (key * 'a) list
+ val min_binding : 'a t -> key * 'a
+ val min_binding_opt : 'a t -> (key * 'a) option
+ val max_binding : 'a t -> key * 'a
+ val max_binding_opt : 'a t -> (key * 'a) option
+ val choose : 'a t -> key * 'a
+ val choose_opt : 'a t -> (key * 'a) option
+ val split : key -> 'a t -> 'a t * 'a option * 'a t
+ val find : key -> 'a t -> 'a
+ val find_opt : key -> 'a t -> 'a option
+ val find_first : (key -> bool) -> 'a t -> key * 'a
+ val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
+ val find_last : (key -> bool) -> 'a t -> key * 'a
+ val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+ val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+ val of_seq : (key * 'a) Seq.t -> 'a t
+ type data = string
+ type map = data t
+ val of_t : 'a -> 'a
+ val to_t : 'a -> 'a
+ end
+|}];;
let ssmap =
(module SSMap:
MapT with type key = string and type data = string and type map = SSMap.map)
;;
+[%%expect{|
+val ssmap :
+ (module MapT with type data = string and type key = string and type map =
+ SSMap.map) =
+ <module>
+|}];;
let ssmap =
(module struct include SSMap end :
MapT with type key = string and type data = string and type map = SSMap.map)
;;
+[%%expect{|
+val ssmap :
+ (module MapT with type data = string and type key = string and type map =
+ SSMap.map) =
+ <module>
+|}];;
let ssmap =
(let module S = struct include SSMap end in (module S) :
(module
MapT with type key = string and type data = string and type map = SSMap.map))
;;
+[%%expect{|
+val ssmap :
+ (module MapT with type data = string and type key = string and type map =
+ SSMap.map) =
+ <module>
+|}];;
let ssmap =
(module SSMap: MapT with type key = _ and type data = _ and type map = _)
;;
+[%%expect{|
+val ssmap :
+ (module MapT with type data = SSMap.data and type key = SSMap.key and type map =
+ SSMap.map) =
+ <module>
+|}];;
let ssmap : (_,_,_) map = (module SSMap);;
+[%%expect{|
+val ssmap : (SSMap.key, SSMap.data, SSMap.map) map = <module>
+|}];;
add ssmap;;
+[%%expect{|
+- : SSMap.key -> SSMap.data -> SSMap.map -> SSMap.map = <fun>
+|}];;
+
+(*****)
+
+module type S = sig type t end
+
+let x =
+ (module struct type elt = A type t = elt list end : S with type t = _ list)
+;;
+[%%expect{|
+module type S = sig type t end
+Line 4, characters 10-51:
+4 | (module struct type elt = A type t = elt list end : S with type t = _ list)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type t in this module cannot be exported.
+ Its type contains local dependencies: elt list
+|}];;
+
+type 'a s = (module S with type t = 'a);;
+[%%expect{|
+type 'a s = (module S with type t = 'a)
+|}];;
+
+let x : 'a s = (module struct type t = int end);;
+[%%expect{|
+val x : int s = <module>
+|}];;
+
+let x : 'a s = (module struct type t = A end);;
+[%%expect{|
+Line 1, characters 23-44:
+1 | let x : 'a s = (module struct type t = A end);;
+ ^^^^^^^^^^^^^^^^^^^^^
+Error: The type t in this module cannot be exported.
+ Its type contains local dependencies: t
+|}];;
+
+let x : 'a s = (module struct end);;
+[%%expect{|
+Line 1, characters 23-33:
+1 | let x : 'a s = (module struct end);;
+ ^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match: sig end is not included in S
+ The type `t' is required but not provided
+|}];;
+++ /dev/null
-val sort : (module Set.S with type elt = 's) -> 's list -> 's list = <fun>
-val make_set : ('s -> 's -> int) -> (module Set.S with type elt = 's) = <fun>
-val sort_cmp : ('s -> 's -> int) -> 's list -> 's list = <fun>
-module type S = sig type t val x : t end
-val f : (module S with type t = int) -> int = <fun>
-Line 1, characters 6-37:
-1 | let f (module M : S with type t = 'a) = M.x;; (* Error *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The type of this packed module contains variables:
- (module S with type t = 'a)
-val f : (module S with type t = 'a) -> 'a = <fun>
-- : int = 1
-type 'a s = { s : (module S with type t = 'a); }
-- : int s = {s = <module>}
-Line 1, characters 9-19:
-1 | let f {s=(module M)} = M.x;; (* Error *)
- ^^^^^^^^^^
-Error: The type of this packed module contains variables:
- (module S with type t = 'a)
-val f : 'a s -> 'a = <fun>
-type s = { s : (module S with type t = int); }
-val f : s -> int = <fun>
-val f : s -> s -> int = <fun>
-module type S = sig val x : int end
-val f : (module S) -> int -> (module S) -> int = <fun>
-Line 1, characters 8-37:
-1 | let m = (module struct let x = 3 end);; (* Error *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The signature for this packaged module couldn't be inferred.
-val m : (module S) = <module>
-- : int = 7
-- : int = 6
-- : int = 3
-Line 1, characters 4-14:
-1 | let (module M) = m;; (* Error: only allowed in [let .. in] *)
- ^^^^^^^^^^
-Error: Modules are not allowed in this pattern.
-Line 1, characters 14-24:
-1 | class c = let (module M) = m in object end;; (* Error again *)
- ^^^^^^^^^^
-Error: Modules are not allowed in this pattern.
-module M : S
-module type S' = sig val f : int -> int end
-- : int = 6
-module type S = sig type t type u val x : t * u end
-val f :
- (module S with type t = int and type u = bool) list ->
- (module S with type u = bool) list = <fun>
-module TypEq :
- sig
- type ('a, 'b) t
- val apply : ('a, 'b) t -> 'a -> 'b
- val refl : ('a, 'a) t
- val sym : ('a, 'b) t -> ('b, 'a) t
- end
-module rec Typ :
- sig
- module type PAIR =
- sig
- type t
- and t1
- and t2
- val eq : (t, t1 * t2) TypEq.t
- val t1 : t1 Typ.typ
- val t2 : t2 Typ.typ
- end
- type 'a typ =
- Int of ('a, int) TypEq.t
- | String of ('a, string) TypEq.t
- | Pair of (module PAIR with type t = 'a)
- end
-val int : int Typ.typ = Typ.Int <abstr>
-val str : string Typ.typ = Typ.String <abstr>
-val pair : 's1 Typ.typ -> 's2 Typ.typ -> ('s1 * 's2) Typ.typ = <fun>
-val to_string : 'a Typ.typ -> 'a -> string = <fun>
-module type MapT =
- sig
- type key
- type +'a t
- val empty : 'a t
- val is_empty : 'a t -> bool
- val mem : key -> 'a t -> bool
- val add : key -> 'a -> 'a t -> 'a t
- val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
- val singleton : key -> 'a -> 'a t
- val remove : key -> 'a t -> 'a t
- val merge :
- (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
- val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
- val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
- val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
- val iter : (key -> 'a -> unit) -> 'a t -> unit
- val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- val for_all : (key -> 'a -> bool) -> 'a t -> bool
- val exists : (key -> 'a -> bool) -> 'a t -> bool
- val filter : (key -> 'a -> bool) -> 'a t -> 'a t
- val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
- val cardinal : 'a t -> int
- val bindings : 'a t -> (key * 'a) list
- val min_binding : 'a t -> key * 'a
- val min_binding_opt : 'a t -> (key * 'a) option
- val max_binding : 'a t -> key * 'a
- val max_binding_opt : 'a t -> (key * 'a) option
- val choose : 'a t -> key * 'a
- val choose_opt : 'a t -> (key * 'a) option
- val split : key -> 'a t -> 'a t * 'a option * 'a t
- val find : key -> 'a t -> 'a
- val find_opt : key -> 'a t -> 'a option
- val find_first : (key -> bool) -> 'a t -> key * 'a
- val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
- val find_last : (key -> bool) -> 'a t -> key * 'a
- val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
- val map : ('a -> 'b) -> 'a t -> 'b t
- val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
- val to_seq : 'a t -> (key * 'a) Seq.t
- val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
- val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
- val of_seq : (key * 'a) Seq.t -> 'a t
- type data
- type map
- val of_t : data t -> map
- val to_t : map -> data t
- end
-type ('k, 'd, 'm) map =
- (module MapT with type data = 'd and type key = 'k and type map = 'm)
-val add : ('k, 'd, 'm) map -> 'k -> 'd -> 'm -> 'm = <fun>
-module SSMap :
- sig
- type key = String.t
- type 'a t = 'a Map.Make(String).t
- val empty : 'a t
- val is_empty : 'a t -> bool
- val mem : key -> 'a t -> bool
- val add : key -> 'a -> 'a t -> 'a t
- val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
- val singleton : key -> 'a -> 'a t
- val remove : key -> 'a t -> 'a t
- val merge :
- (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
- val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
- val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
- val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
- val iter : (key -> 'a -> unit) -> 'a t -> unit
- val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- val for_all : (key -> 'a -> bool) -> 'a t -> bool
- val exists : (key -> 'a -> bool) -> 'a t -> bool
- val filter : (key -> 'a -> bool) -> 'a t -> 'a t
- val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
- val cardinal : 'a t -> int
- val bindings : 'a t -> (key * 'a) list
- val min_binding : 'a t -> key * 'a
- val min_binding_opt : 'a t -> (key * 'a) option
- val max_binding : 'a t -> key * 'a
- val max_binding_opt : 'a t -> (key * 'a) option
- val choose : 'a t -> key * 'a
- val choose_opt : 'a t -> (key * 'a) option
- val split : key -> 'a t -> 'a t * 'a option * 'a t
- val find : key -> 'a t -> 'a
- val find_opt : key -> 'a t -> 'a option
- val find_first : (key -> bool) -> 'a t -> key * 'a
- val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
- val find_last : (key -> bool) -> 'a t -> key * 'a
- val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
- val map : ('a -> 'b) -> 'a t -> 'b t
- val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
- val to_seq : 'a t -> (key * 'a) Seq.t
- val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
- val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
- val of_seq : (key * 'a) Seq.t -> 'a t
- type data = string
- type map = data t
- val of_t : 'a -> 'a
- val to_t : 'a -> 'a
- end
-val ssmap :
- (module MapT with type data = string and type key = string and type map =
- SSMap.map) =
- <module>
-val ssmap :
- (module MapT with type data = string and type key = string and type map =
- SSMap.map) =
- <module>
-val ssmap :
- (module MapT with type data = string and type key = string and type map =
- SSMap.map) =
- <module>
-val ssmap :
- (module MapT with type data = SSMap.data and type key = SSMap.key and type map =
- SSMap.map) =
- <module>
-val ssmap : (SSMap.key, SSMap.data, SSMap.map) map = <module>
-- : SSMap.key -> SSMap.data -> SSMap.map -> SSMap.map = <fun>
-
+++ /dev/null
-implicit_unpack.ml
+++ /dev/null
-mixin2.ml
-mixin3.ml
-mixin.ml
+++ /dev/null
-core_array_reduced_ok.ml
-pr6303_bad.ml
-pr6946_bad.ml
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-97:
- ......struct
- type t = A | B
-
- let f (x : t) =
- match x with
- | A -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type t = A | B
+ 5 |
+ 6 | let f (x : t) =
+ 7 | match x with
+ 8 | | A -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type t = A.t = A | B val f : t -> unit end
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-110:
- ......struct
- type 'a t = A of 'a | B
-
- let f (x : _ t) =
- match x with
- | A _ -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type 'a t = A of 'a | B
+ 5 |
+ 6 | let f (x : _ t) =
+ 7 | match x with
+ 8 | | A _ -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type 'a t = 'a B.t = A of 'a | B val f : 'a t -> unit end
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-110:
- ......struct
- type 'a t = A of 'a | B
-
- let f (x : _ t) =
- match x with
- | A _ -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type 'a t = A of 'a | B
+ 5 |
+ 6 | let f (x : _ t) =
+ 7 | match x with
+ 8 | | A _ -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type 'a t = 'a C.t = A of 'a | B val f : 'a t -> unit end
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-110:
- ......struct
- type 'a t = A of 'a | B
-
- let f (x : _ t) =
- match x with
- | A _ -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type 'a t = A of 'a | B
+ 5 |
+ 6 | let f (x : _ t) =
+ 7 | match x with
+ 8 | | A _ -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type 'a t = 'a D.t = A of 'a | B val f : 'a t -> unit end
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-110:
- ......struct
- type 'a t = A of 'a | B
-
- let f (x : _ t) =
- match x with
- | A _ -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type 'a t = A of 'a | B
+ 5 |
+ 6 | let f (x : _ t) =
+ 7 | match x with
+ 8 | | A _ -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type 'a t = 'a E.t = A of 'a | B val f : 'a t -> unit end
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-110:
- ......struct
- type 'a t = A of 'a | B
-
- let f (x : _ t) =
- match x with
- | A _ -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type 'a t = A of 'a | B
+ 5 |
+ 6 | let f (x : _ t) =
+ 7 | match x with
+ 8 | | A _ -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type 'a t = 'a E2.t = A of 'a | B val f : 'a t -> unit end
| B -> ()
end;;
[%%expect{|
-Line _, characters 6-110:
- ......struct
- type 'a t = A of 'a | B
-
- let f (x : _ t) =
- match x with
- | A _ -> ()
- | B -> ()
- end..
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 | type 'a t = A of 'a | B
+ 5 |
+ 6 | let f (x : _ t) =
+ 7 | match x with
+ 8 | | A _ -> ()
+ 9 | | B -> ()
+10 | end..
Error: Signature mismatch:
Modules do not match:
sig type 'a t = 'a E3.t = A of 'a | B val f : 'a t -> unit end
let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x
end;;
[%%expect{|
-Line _, characters 6-201:
- ......struct
- type ('a, 'b) t = Foo of 'b
-
- (* this function typechecks properly, which means that we've added the
- manisfest. *)
- let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x
- end..
+Lines 3-9, characters 6-3:
+3 | ......struct
+4 | type ('a, 'b) t = Foo of 'b
+5 |
+6 | (* this function typechecks properly, which means that we've added the
+7 | manisfest. *)
+8 | let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x
+9 | end..
Error: Signature mismatch:
Modules do not match:
sig
type ('a, 'b) t = ('a, 'b) F.t = Foo of 'b
is not included in
type ('a, 'b) t = Foo of 'a
- The types for field Foo are not equal.
+ Constructors do not match:
+ Foo of 'b
+ is not compatible with:
+ Foo of 'a
+ The types are not equal.
|}];;
--- /dev/null
+(* TEST
+ * expect
+*)
+
+class type foo_t =
+ object
+ method foo: string
+ end
+
+module M: sig
+ class type ct = object val m: string end
+end = struct
+ class type ct = object end
+end
+
+[%%expect{|
+class type foo_t = object method foo : string end
+Lines 8-10, characters 6-3:
+ 8 | ......struct
+ 9 | class type ct = object end
+10 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig class type ct = object end end
+ is not included in
+ sig class type ct = object val m : string end end
+ Class type declarations do not match:
+ class type ct = object end
+ does not match
+ class type ct = object val m : string end
+ The first class type has no instance variable m
+|}]
+
+module M: sig
+ class c : object
+ method a: string
+ end
+end = struct
+ class virtual c = object
+ method virtual a: string
+ end
+end
+;;
+[%%expect{|
+Lines 5-9, characters 6-3:
+5 | ......struct
+6 | class virtual c = object
+7 | method virtual a: string
+8 | end
+9 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig class virtual c : object method virtual a : string end end
+ is not included in
+ sig class c : object method a : string end end
+ Class declarations do not match:
+ class virtual c : object method virtual a : string end
+ does not match
+ class c : object method a : string end
+ A class cannot be changed from virtual to concrete
+|}]
+
+class type ['a] ct = object val x: 'a end
+
+module M: sig
+ class type ['a] c = object end
+end = struct
+ class type c = object end
+end
+;;
+
+[%%expect{|
+class type ['a] ct = object val x : 'a end
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 | class type c = object end
+7 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig class type c = object end end
+ is not included in
+ sig class type ['a] c = object end end
+ Class type declarations do not match:
+ class type c = object end
+ does not match
+ class type ['a] c = object end
+ The classes do not have the same number of type parameters
+|}]
+
+module M: sig
+ class ['a] c: object constraint 'a = int end
+end = struct
+ class ['a] c = object end
+end
+;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | class ['a] c = object end
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig class ['a] c : object end end
+ is not included in
+ sig class ['a] c : object constraint 'a = int end end
+ Class declarations do not match:
+ class ['a] c : object end
+ does not match
+ class ['a] c : object constraint 'a = int end
+ A type parameter has type 'a but is expected to have type int
+|}]
+
+module M: sig
+ class c : int -> object end
+end = struct
+ class c (x : float) = object end
+end
+;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | class c (x : float) = object end
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig class c : float -> object end end
+ is not included in
+ sig class c : int -> object end end
+ Class declarations do not match:
+ class c : float -> object end
+ does not match
+ class c : int -> object end
+ A parameter has type float but is expected to have type int
+|}]
+
+class virtual foo: foo_t =
+ object
+ method foo = "foo"
+ method private virtual cast: int
+ end
+;;
+
+[%%expect{|
+Lines 2-5, characters 4-7:
+2 | ....object
+3 | method foo = "foo"
+4 | method private virtual cast: int
+5 | end
+Error: The class type object method foo : string end
+ is not matched by the class type foo_t
+ The virtual method cast cannot be hidden
+|}]
+
+class type foo_t2 =
+ object
+ method private foo: string
+ end
+
+class foo: foo_t2 =
+ object
+ method foo = "foo"
+ end
+;;
+[%%expect{|
+class type foo_t2 = object method private foo : string end
+Lines 7-9, characters 4-7:
+7 | ....object
+8 | method foo = "foo"
+9 | end
+Error: The class type object method foo : string end
+ is not matched by the class type foo_t2
+ The public method foo cannot become private
+|}]
+
+class virtual foo: foo_t =
+ object
+ method virtual foo: string
+ end
+;;
+[%%expect{|
+Lines 2-4, characters 4-7:
+2 | ....object
+3 | method virtual foo: string
+4 | end
+Error: The class type object method virtual foo : string end
+ is not matched by the class type foo_t
+ The virtual method foo cannot become concrete
+|}]
+
+class type foo_t3 =
+ object
+ val mutable x : int
+ end
+
+class foo: foo_t3 =
+ object
+ val x = 1
+ end
+;;
+[%%expect{|
+class type foo_t3 = object val mutable x : int end
+Lines 7-9, characters 4-7:
+7 | ....object
+8 | val x = 1
+9 | end
+Error: The class type object val x : int end is not matched by the class type
+ foo_t3
+ The non-mutable instance variable x cannot become mutable
+|}]
+
+class type foo_t4 =
+ object
+ val x : int
+ end
+
+class virtual foo: foo_t4 =
+ object
+ val virtual x : int
+ end
+;;
+[%%expect{|
+class type foo_t4 = object val x : int end
+Lines 7-9, characters 4-7:
+7 | ....object
+8 | val virtual x : int
+9 | end
+Error: The class type object val virtual x : int end
+ is not matched by the class type foo_t4
+ The virtual instance variable x cannot become concrete
+|}]
+
+module M: sig
+ class type c = object method m: string end
+end = struct
+ class type c = object method private m: string end
+end
+;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | class type c = object method private m: string end
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig class type c = object method private m : string end end
+ is not included in
+ sig class type c = object method m : string end end
+ Class type declarations do not match:
+ class type c = object method private m : string end
+ does not match
+ class type c = object method m : string end
+ The private method m cannot become public
+|}]
+++ /dev/null
-constraints.ml
-disambiguate_principality.ml
-exotic_unifications.ml
-inside_out.ml
-is_expansive.ml
-labels.ml
-occur_check.ml
-pat_type_sharing.ml
-pattern_open.ml
-polyvars.ml
-pr6416.ml
-pr6634.ml
-pr6939-flat-float-array.ml
-pr6939-no-flat-float-array.ml
-pr7103.ml
-pr7228.ml
-pr7668_bad.ml
-pr7937.ml
-pr8548.ml
-pr8548_split.ml
-gpr2277.ml
-printing.ml
-records.ml
-scope_escape.ml
-unique_names_in_unification.ml
-variant.ml
-wellfounded.ml
-empty_variant.ml
-typecore_errors.ml
-typecore_nolabel_errors.ml
-typecore_empty_polyvariant_error.ml
-typetexp_errors.ml
-external_arity.ml
[ `A ]
These two variant types have no intersection
|}]
+
+type t = private [< `A]
+let f: t -> [ `A ] = fun x -> x
+[%%expect {|
+type t = private [< `A ]
+Line 2, characters 30-31:
+2 | let f: t -> [ `A ] = fun x -> x
+ ^
+Error: This expression has type t but an expression was expected of type
+ [ `A ]
+ The first variant type is private, it may not allow the tag(s) `A
+|}]
type u = A of t/1
is not included in
type u = A of t/2
- The types for field A are not equal.
+ Constructors do not match:
+ A of t/1
+ is not compatible with:
+ A of t/2
+ The types are not equal.
Line 4, characters 9-19:
Definition of type t/1
Line 2, characters 2-11:
7 | end
Error: Signature mismatch:
Modules do not match:
- sig module type s module A : functor (X : s) -> sig end end
+ sig module type s module A : functor (X : s) -> sig end end
is not included in
- sig module A : functor (X : s) -> sig end end
+ sig module A : functor (X : s) -> sig end end
In module A:
Modules do not match:
- functor (X : s/1) -> sig end
+ functor (X : s/1) -> sig end
is not included in
- functor (X : s/2) -> sig end
+ functor (X : s/2) -> sig end
At position module A(X : <here>) : ...
Modules do not match: s/2 is not included in s/1
Line 5, characters 6-19:
type t = A of T/1.t
is not included in
type t = A of T/2.t
- The types for field A are not equal.
+ Constructors do not match:
+ A of T/1.t
+ is not compatible with:
+ A of T/2.t
+ The types are not equal.
Line 5, characters 6-34:
Definition of module T/1
Line 2, characters 2-30:
[%%expect{|
module Bar : sig type info = { doc : unit; } end
module Foo : sig type t = { info : Bar.info; } end
-module Bar : sig end
+module Bar : sig end
Line 8, characters 38-41:
8 | let add_extra_info arg = arg.Foo.info.doc
^^^
range -> 'a
end
end
- end) ->
+ end)
+ ->
sig
module Point : sig type t end
module Test_range :
[%%expect{|
type (' a', ' a'b, 'cd') t = ' a'b -> ' a' * 'cd'
|}];;
+
+
+(* #8856: cycles in types expressions could trigger stack overflows
+ when printing subpart of error messages *)
+
+type 'a t = private X of 'a
+let zeros = object(self) method next = 0, self end
+let x = X zeros;;
+[%%expect {|
+type 'a t = private X of 'a
+val zeros : < next : int * 'a > as 'a = <obj>
+Line 3, characters 8-15:
+3 | let x = X zeros;;
+ ^^^^^^^
+Error: Cannot create values of the private type (< next : int * 'a > as 'a) t
+|}]
+
+
+type ('a,'b) eq = Refl: ('a,'a) eq
+type t = <m : int * 't> as 't
+let f (x:t) (type a) (y:a) (witness:(a,t) eq) = match witness with
+ | Refl -> if true then x else y
+[%%expect {|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+type t = < m : int * 'a > as 'a
+Line 4, characters 32-33:
+4 | | Refl -> if true then x else y
+ ^
+Error: This expression has type a but an expression was expected of type t
+ This instance of < m : int * 'a > as 'a is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+
+type t1 = <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>
+type t2 = <m : 'a. 'a * ('a * 'foo)> as 'foo
+let f (x : t1) : t2 = x;;
+[%%expect {|
+type t1 = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
+type t2 = < m : 'a. 'a * ('a * 'b) > as 'b
+Line 3, characters 22-23:
+3 | let f (x : t1) : t2 = x;;
+ ^
+Error: This expression has type t1 but an expression was expected of type t2
+ The method m has type 'c. 'c * ('a * < m : 'c. 'b >) as 'b,
+ but the expected method type was 'a. 'a * ('a * < m : 'a. 'b >) as 'b
+ The universal variable 'a would escape its scope
+|}]
2 | type mut = d = {x:int; mutable y:int}
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- The mutability of field y is different.
+ Fields do not match:
+ y : int;
+ is not compatible with:
+ mutable y : int;
+ This is mutable and the original is not.
|}]
type missing = d = { x:int }
1 | type wrong_type = d = {x:float}
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- The types for field x are not equal.
+ Fields do not match:
+ x : int;
+ is not compatible with:
+ x : float;
+ The types are not equal.
|}]
type unboxed = d = {x:float} [@@unboxed]
|}]
-(** Masked instance variable *)
-let c = object val x= 0 val y = x end
-[%%expect{|
-Line 1, characters 32-33:
-1 | let c = object val x= 0 val y = x end
- ^
-Error: The instance variable x
- cannot be accessed from the definition of another instance variable
-|}]
-
-
(** No value clause *)
let f x = match x with exception Not_found -> ();;
let f (x:int) = ()
let x = f (module struct end)
[%%expect {|
-module type empty = sig end
+module type empty = sig end
val f : int -> unit = <fun>
Line 3, characters 10-29:
3 | let x = f (module struct end)
Hint: Either add `C in the upper bound, or remove it
from the lower bound.
|}]
+
+type ('_a) underscored = A of '_a
+[%%expect {|
+Line 1, characters 6-9:
+1 | type ('_a) underscored = A of '_a
+ ^^^
+Error: The type variable name '_a is not allowed in programs
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* #8698 *)
+
+(* Actually, this is not a bug *)
+type +'a t = [> `Foo of 'a -> unit] as 'a;;
+[%%expect{|
+type 'a t = 'a constraint 'a = [> `Foo of 'a -> unit ]
+|}, Principal{|
+type +'a t = 'a constraint 'a = [> `Foo of 'a -> unit ]
+|}]
3 | type missing = d = X of int
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- The field Y is only present in the original definition.
+ The constructor Y is only present in the original definition.
|}]
type wrong_type = d = X of float
1 | type wrong_type = d = X of float
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- The types for field X are not equal.
+ Constructors do not match:
+ X of int
+ is not compatible with:
+ X of float
+ The types are not equal.
|}]
type unboxed = d = X of float [@@unboxed]
1 | type perm = d = Y of int | X of int
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- Fields number 1 have different names, X and Y.
+ Constructors number 1 have different names, X and Y.
+|}]
+
+module M : sig
+ type t = Foo of int
+end = struct
+ type t = Foo : int -> t
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = Foo : int -> t
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo : int -> t end
+ is not included in
+ sig type t = Foo of int end
+ Type declarations do not match:
+ type t = Foo : int -> t
+ is not included in
+ type t = Foo of int
+ Constructors do not match:
+ Foo : int -> t
+ is not compatible with:
+ Foo of int
+ The first has explicit return type and the second doesn't.
|}]
+++ /dev/null
-gatien_baron_20131019_ok.ml
-pr5164_ok.ml
-pr51_ok.ml
-pr5663_ok.ml
-pr5914_ok.ml
-pr6240_ok.ml
-pr6293_bad.ml
-pr6427_bad.ml
-pr6485_ok.ml
-pr6513_ok.ml
-pr6572_ok.ml
-pr6651_ok.ml
-pr6752_bad.ml
-pr6752_ok.ml
-pr6899_first_bad.ml
-pr6899_ok.ml
-pr6899_second_bad.ml
-pr6944_ok.ml
-pr6954_ok.ml
-pr6981_ok.ml
-pr6982_ok.ml
-pr6985_ok.ml
-pr6992_bad.ml
-pr7036_ok.ml
-pr7082_ok.ml
-pr7112_bad.ml
-pr7112_ok.ml
-pr7152_ok.ml
-pr7182_ok.ml
-pr7305_principal.ml
-pr7321_ok.ml
-pr7414_bad.ml
-pr7414_2_bad.ml
-pr7519_ok.ml
-pr7601_ok.ml
-pr7601a_ok.ml
type t
is not included in
type t = { a : int; b : int; }
+ Their kinds differ.
File "pr6293_bad.ml", line 9, characters 20-50: Expected declaration
File "pr6293_bad.ml", line 10, characters 18-37: Actual declaration
- Their kinds differ.
module type S = sig module rec M : sig end and N : sig end end;;
module type S' = S with module M := String;;
[%%expect{|
-module type S = sig module rec M : sig end and N : sig end end
-module type S' = sig module rec N : sig end end
+module type S = sig module rec M : sig end and N : sig end end
+module type S' = sig module rec N : sig end end
|}];;
(* with module type *)
3 | module type B = A with type t = u;; (* fail *)
^^^^^^^^^^
Error: This variant or record definition does not match that of type u
- The types for field X are not equal.
+ Constructors do not match:
+ X of bool
+ is not compatible with:
+ X of int
+ The types are not equal.
|}];;
(* PR#5815 *)
module F(X : sig end) = struct let x = 3 end;;
F.x;; (* fail *)
[%%expect{|
-module F : functor (X : sig end) -> sig val x : int end
+module F : functor (X : sig end) -> sig val x : int end
Line 2, characters 0-3:
2 | F.x;; (* fail *)
^^^
type t += E of int
is not included in
type t += E
- The arities for field E differ.
+ Constructors do not match:
+ E of int
+ is not compatible with:
+ E
+ They have different arities.
|}];;
module M : sig type t += E of char end = struct type t += E of int end;;
type t += E of int
is not included in
type t += E of char
- The types for field E are not equal.
+ Constructors do not match:
+ E of int
+ is not compatible with:
+ E of char
+ The types are not equal.
|}];;
module M : sig type t += C of int end = struct type t += E of int end;;
type t += E of int
is not included in
type t += E of { x : int; }
- The types for field E are not equal.
+ Constructors do not match:
+ E of int
+ is not compatible with:
+ E of { x : int; }
+ The second uses inline records and the first doesn't.
|}];;
C4.chr 66;;
[%%expect{|
module F :
- functor (X : sig end) ->
+ functor (X : sig end) ->
sig
external code : char -> int = "%identity"
val chr : int -> char
module G(X:sig end) = struct module M = X end;; (* does not alias X *)
module M = G(struct end);;
[%%expect{|
-module G : functor (X : sig end) -> sig module M : sig end end
-module M : sig module M : sig end end
+module G : functor (X : sig end) -> sig module M : sig end end
+module M : sig module M : sig end end
|}];;
module M' = struct
M5.N'.x;;
[%%expect{|
module F :
- functor (X : sig end) ->
+ functor (X : sig end) ->
sig module N : sig val x : int end module N' = N end
-module G : functor (X : sig end) -> sig module N' : sig val x : int end end
+module G : functor (X : sig end) -> sig module N' : sig val x : int end end
module M5 : sig module N' : sig val x : int end end
- : int = 1
|}];;
include T;;
let f (x : t) : T.t = x ;;
[%%expect{|
-module F : functor (M : sig end) -> sig type t end
-module T : sig module M : sig end type t = F(M).t end
+module F : functor (M : sig end) -> sig type t end
+module T : sig module M : sig end type t = F(M).t end
module M = T.M
type t = F(M).t
val f : t -> T.t = <fun>
(*module N = G (M);;
module N = F (M.Y) (M);;*)
[%%expect{|
-module FF : functor (X : sig end) -> sig type t end
+module FF : functor (X : sig end) -> sig type t end
module M :
- sig
- module X : sig end
- module Y : sig type t = FF(X).t end
- type t = Y.t
- end
-module F :
- functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end
-module G : functor (M : sig type t = M.Y.t end) -> sig end
+ sig module X : sig end module Y : sig type t = FF(X).t end type t = Y.t end
+module F : functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end
+module G : functor (M : sig type t = M.Y.t end) -> sig end
|}];;
(* PR#6307 *)
module F1 = F(L1);; (* ok *)
module F2 = F(L2);; (* should succeed too *)
[%%expect{|
-module A1 : sig end
-module A2 : sig end
+module A1 : sig end
+module A2 : sig end
module L1 : sig module X = A1 end
module L2 : sig module X = A2 end
-module F : functor (L : sig module X : sig end end) -> sig end
-module F1 : sig end
-module F2 : sig end
+module F : functor (L : sig module X : sig end end) -> sig end
+module F1 : sig end
+module F2 : sig end
|}];;
(* Counter example: why we need to be careful with PR#6307 *)
module type A = Alias with module N := F(List);;
module rec Bad : A = Bad;;
[%%expect{|
-module type Alias = sig module N : sig end module M = N end
-module F : functor (X : sig end) -> sig type t end
+module type Alias = sig module N : sig end module M = N end
+module F : functor (X : sig end) -> sig type t end
Line 1:
Error: Module type declarations do not match:
module type A = sig module M = F(List) end
module Q = M
end;;
[%%expect{|
-module type S = sig module M : sig module P : sig end end module Q = M end
+module type S = sig module M : sig module P : sig end end module Q = M end
|}];;
module type S = sig
module M : sig module N : sig end module P : sig end end
[%%expect{|
module type S =
sig
- module M : sig module N : sig end module P : sig end end
+ module M : sig module N : sig end module P : sig end end
module Q : sig module N = M.N module P = M.P end
end
module R :
sig
- module M : sig module N : sig end module P : sig end end
+ module M : sig module N : sig end module P : sig end end
module Q = M
end
module R' : S
type a = Foo.b
end;;
[%%expect{|
-module F : functor (X : sig end) -> sig type t end
+module F : functor (X : sig end) -> sig type t end
module M :
- sig type a module Foo : sig module Bar : sig end type b = a end end
+ sig type a module Foo : sig module Bar : sig end type b = a end end
|}];;
(* PR#6578 *)
module type S = module type of struct include X end
end;;
[%%expect{|
-module X : sig module N : sig end end
+module X : sig module N : sig end end
module Y : sig module type S = sig module N = X.N end end
|}];;
[%%expect {|
module type S =
sig
- module M : sig module A : sig end module B : sig end end
+ module M : sig module A : sig end module B : sig end end
module N = M.A
end
module Foo :
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module _ = struct end;;
+[%%expect{|
+|}];;
+
+module rec A : sig
+ type t = B.t
+end = A
+and _ : sig type t = A.t end = struct type t = A.t end
+and B : sig type t end = B
+;;
+[%%expect{|
+module rec A : sig type t = B.t end
+and B : sig type t end
+|}]
+
+module type S = sig
+ module _ : sig end
+
+ module rec A : sig
+ type t = B.t
+ end
+ and _ : sig type t = A.t end
+ and B : sig type t end
+end
+;;
+[%%expect{|
+module type S =
+ sig module rec A : sig type t = B/2.t end and B : sig type t end end
+|}]
+
+let f (module _ : S) = ()
+;;
+[%%expect{|
+val f : (module S) -> unit = <fun>
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type t = ..;;
+
+module M : sig type t += E | F end = struct type t += E | F of int end;;
+[%%expect{|
+type t = ..
+Line 3, characters 37-70:
+3 | module M : sig type t += E | F end = struct type t += E | F of int end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t += E | F of int end
+ is not included in
+ sig type t += E | F end
+ Extension declarations do not match:
+ type t += F of int
+ is not included in
+ type t += F
+ Constructors do not match:
+ F of int
+ is not compatible with:
+ F
+ They have different arities.
+|}];;
+
+module M1 : sig type t += A end = struct type t += private A end;;
+[%%expect{|
+Line 1, characters 34-64:
+1 | module M1 : sig type t += A end = struct type t += private A end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t += private A end
+ is not included in
+ sig type t += A end
+ Extension declarations do not match:
+ type t += private A
+ is not included in
+ type t += A
+ A private type would be revealed.
+|}];;
module type S = sig val x : int end
val v : (module S) = <module>
module F : functor () -> S
-module G : functor (X : sig end) -> S
-module H : functor (X : sig end) -> S
+module G : functor (X : sig end) -> S
+module H : functor (X : sig end) -> S
|}];;
(* With type *)
module U = struct end;;
module M = F(struct end);; (* ok *)
[%%expect{|
-module U : sig end
+module U : sig end
module M : S
|}];;
module M = F(U);; (* fail *)
module F1 (X : sig end) = struct end;;
module F2 : functor () -> sig end = F1;; (* fail *)
[%%expect{|
-module F1 : functor (X : sig end) -> sig end
+module F1 : functor (X : sig end) -> sig end
Line 2, characters 36-38:
2 | module F2 : functor () -> sig end = F1;; (* fail *)
^^
Error: Signature mismatch:
Modules do not match:
- functor (X : sig end) -> sig end
+ functor (X : sig end) -> sig end
is not included in
- functor () -> sig end
+ functor () -> sig end
|}];;
module F3 () = struct end;;
module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
[%%expect{|
-module F3 : functor () -> sig end
+module F3 : functor () -> sig end
Line 2, characters 47-49:
2 | module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
^^
Error: Signature mismatch:
Modules do not match:
- functor () -> sig end
+ functor () -> sig end
is not included in
- functor (X : sig end) -> sig end
+ functor (X : sig end) -> sig end
|}];;
(* tests for shortened functor notation () *)
module GZ : functor (X: sig end) () (Z: sig end) -> sig end
= functor (X: sig end) () (Z: sig end) -> struct end;;
[%%expect{|
-module X : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end
-module Y : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end
-module Z : sig end -> sig end -> sig end -> sig end
-module GZ : functor (X : sig end) () (Z : sig end) -> sig end
+module X : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end
+module Y : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end
+module Z : sig end -> sig end -> sig end -> sig end
+module GZ : functor (X : sig end) () (Z : sig end) -> sig end
|}];;
module B :
sig
module C :
- functor
- (X : sig end) (Y : sig end) (Z : sig
- module D :
- sig
- module E :
- sig
- module F :
- functor
- (X :
- sig
-
- end) (Arg :
- sig
- val two :
- int
- val one :
- int
- end) ->
- sig end
- end
- end
- end) ->
- sig end
+ functor (X : sig end) (Y : sig end)
+ (Z : sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ functor (X : sig end)
+ (Arg : sig
+ val two : int
+ val one : int
+ end)
+ -> sig end
+ end
+ end
+ end)
+ -> sig end
end
end
end
module B :
sig
module C :
- functor
- (X : sig end) (Y : sig end) (Z : sig
- module D :
- sig
- module E :
- sig
- module F :
- functor
- (X :
- sig
-
- end) (Arg :
- sig
- val one :
- int
- val two :
- int
- end) ->
- sig end
- end
- end
- end) ->
- sig end
+ functor (X : sig end) (Y : sig end)
+ (Z : sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ functor (X : sig end)
+ (Arg : sig
+ val one : int
+ val two : int
+ end)
+ -> sig end
+ end
+ end
+ end)
+ -> sig end
end
end
end
module B :
sig
module C :
- functor
- (X : sig end) (Y : sig end) (Z : sig
- module D :
- sig
- module E :
- sig
- module F :
- functor
- (X :
- sig
-
- end) (Arg :
- sig
- val two :
- int
- val one :
- int
- end) ->
- sig end
- end
- end
- end) ->
- sig end
+ functor (X : sig end) (Y : sig end)
+ (Z : sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ functor (X : sig end)
+ (Arg : sig
+ val two : int
+ val one : int
+ end)
+ -> sig end
+ end
+ end
+ end)
+ -> sig end
end
end
end
module B :
sig
module C :
- functor
- (X : sig end) (Y : sig end) (Z : sig
- module D :
- sig
- module E :
- sig
- module F :
- functor
- (X :
- sig
-
- end) (Arg :
- sig
- val one :
- int
- val two :
- int
- end) ->
- sig end
- end
- end
- end) ->
- sig end
+ functor (X : sig end) (Y : sig end)
+ (Z : sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ functor (X : sig end)
+ (Arg : sig
+ val one : int
+ val two : int
+ end)
+ -> sig end
+ end
+ end
+ end)
+ -> sig end
end
end
end
type t = int
end;;
[%%expect{|
-module F : sig end -> sig type t = private int end
+module F : sig end -> sig type t = private int end
|}]
module Direct = F(struct end);;
type t = F(X).t
end = F(X);;
[%%expect{|
-module G : functor (X : sig end) -> sig type t = F(X).t end
+module G : functor (X : sig end) -> sig type t = F(X).t end
|}]
module Indirect = G(struct end);;
type t = [ `Foo of t ]
end;;
[%%expect{|
-module Pub : sig end -> sig type t = [ `Foo of t ] end
+module Pub : sig end -> sig type t = [ `Foo of t ] end
|}]
module Priv(_ : sig end) = struct
type t = private [ `Foo of t ]
end;;
[%%expect{|
-module Priv : sig end -> sig type t = private [ `Foo of t ] end
+module Priv : sig end -> sig type t = private [ `Foo of t ] end
|}]
module DirectPub = Pub(struct end);;
type t = Pub(X).t
end = Pub(X);;
[%%expect{|
-module H : functor (X : sig end) -> sig type t = Pub(X).t end
+module H : functor (X : sig end) -> sig type t = Pub(X).t end
|}]
module I(X : sig end) : sig
type t = Priv(X).t
end = Priv(X);;
[%%expect{|
-module I : functor (X : sig end) -> sig type t = Priv(X).t end
+module I : functor (X : sig end) -> sig type t = Priv(X).t end
|}]
module IndirectPub = H(struct end);;
end;;
[%%expect{|
module Priv :
- sig end -> sig type t = private [ `Bar of int | `Foo of t -> int ] end
+ sig end -> sig type t = private [ `Bar of int | `Foo of t -> int ] end
|}]
module I(X : sig end) : sig
type t = Priv(X).t
end = Priv(X);;
[%%expect{|
-module I : functor (X : sig end) -> sig type t = Priv(X).t end
+module I : functor (X : sig end) -> sig type t = Priv(X).t end
|}]
module IndirectPriv = I(struct end);;
+++ /dev/null
-aliases.ml
-applicative_functor_type.ml
-firstclass.ml
-generative.ml
-illegal_permutation.ml
-nondep.ml
-nondep_private_abbrev.ml
-normalize_path.ml
-pr5911.ml
-pr6394.ml
-pr7207.ml
-pr7348.ml
-pr7726.ml
-pr7787.ml
-pr7818.ml
-pr7851.ml
-pr8810.ml
-printing.ml
-recursive.ml
-Test.ml
-unroll_private_abbrev.ml
end;;
[%%expect{|
module type S = sig type t val x : t end
-module Good : functor (X : sig val x : unit end) -> sig end
+module Good : functor (X : sig val x : unit end) -> sig end
|}];;
module type T = sig module M : S end;;
[%%expect{|
module type T = sig module M : S end
module Bad :
- functor (X : sig module M : sig type t = unit val x : t end end) ->
- sig end
+ functor (X : sig module M : sig type t = unit val x : t end end) -> sig end
|}];;
module F (X : sig end) = struct type t = int end;;
type t = F(Does_not_exist).t;;
[%%expect{|
-module F : functor (X : sig end) -> sig type t = int end
+module F : functor (X : sig end) -> sig type t = int end
Line 2, characters 9-28:
2 | type t = F(Does_not_exist).t;;
^^^^^^^^^^^^^^^^^^^
let _ = (N.x = M.x)
end;;
[%%expect{|
-module A : sig end
+module A : sig end
|}]
type t = F(M).t;;
[%%expect{|
module F : functor () -> sig type t end
-module M : sig end
+module M : sig end
Line 3, characters 9-15:
3 | type t = F(M).t;;
^^^^^^
functor (F : T -> T) ->
sig
module rec Fixed : sig type t = F(Fixed).t end
- module R : functor (X : sig end) -> sig type t = Fixed.t end
+ module R : functor (X : sig end) -> sig type t = Fixed.t end
end
Line 5, characters 11-26:
5 | let f (x : Fix2(Id).R(M).t) = x;;
[%%expect{|
module Termsig :
sig
- module Term0 : sig module type S = sig module Id : sig end end end
+ module Term0 : sig module type S = sig module Id : sig end end end
module Term :
sig module type S = sig module Term0 : Term0.S module T = Term0 end end
end
functor
(T' : sig
module Term0 : Termsig.Term0.S
- module T : sig module Id : sig end end
- end) ->
- sig module T : sig module Id : sig end val u : int end end
+ module T : sig module Id : sig end end
+ end)
+ -> sig module T : sig module Id : sig end val u : int end end
|}]
module Make2 (T' : Termsig.Term.S) = struct
functor
(T' : sig
module Term0 : Termsig.Term0.S
- module T : sig module Id : sig end end
- end) ->
+ module T : sig module Id : sig end end
+ end)
+ ->
sig
- module T : sig module Id : sig end module Id2 = Id val u : int end
+ module T : sig module Id : sig end module Id2 = Id val u : int end
end
|}]
functor
(T' : sig
module Term0 : Termsig.Term0.S
- module T : sig module Id : sig end end
- end) ->
+ module T : sig module Id : sig end end
+ end)
+ ->
sig
- module T : sig module Id : sig end module Id2 = Id val u : int end
+ module T : sig module Id : sig end module Id2 = Id val u : int end
end
|}]
end;;
[%%expect{|
module type S =
- sig module Term0 : sig module Id : sig end end module T = Term0 end
+ sig module Term0 : sig module Id : sig end end module T = Term0 end
module Make1 :
functor
(T' : sig
- module Term0 : sig module Id : sig end end
- module T : sig module Id : sig end end
- end) ->
- sig module Id : sig end module Id2 = Id end
+ module Term0 : sig module Id : sig end end
+ module T : sig module Id : sig end end
+ end)
+ -> sig module Id : sig end module Id2 = Id end
|}]
module Make2 (T' : S) : sig module Id : sig end module Id2 = Id end
5 | end..
Error: Signature mismatch:
Modules do not match:
- sig module Id : sig end module Id2 = Id end
+ sig module Id : sig end module Id2 = Id end
is not included in
sig module Id2 = T'.Term0.Id end
In module Id2:
module Make3 :
functor
(T' : sig
- module Term0 : sig module Id : sig end end
- module T : sig module Id : sig end end
- end) ->
+ module Term0 : sig module Id : sig end end
+ module T : sig module Id : sig end end
+ end)
+ ->
sig
- module T : sig module Id : sig end module Id2 = Id val u : int end
+ module T : sig module Id : sig end module Id2 = Id val u : int end
end
|}]
struct module Id = struct let x = "a" end end module T = Term0 end);;
M.Id.x;;
[%%expect{|
-module M : sig module Id : sig end module Id2 = Id end
+module M : sig module Id : sig end module Id2 = Id end
Line 3, characters 0-6:
3 | M.Id.x;;
^^^^^^
module M = Make1(IS);;
[%%expect{|
-module MkT : functor (X : sig end) -> sig type t end
+module MkT : functor (X : sig end) -> sig type t end
module type S =
sig
- module Term0 : sig module Id : sig end end
+ module Term0 : sig module Id : sig end end
module T = Term0
type t = MkT(T).t
end
module Make1 :
functor
(T' : sig
- module Term0 : sig module Id : sig end end
- module T : sig module Id : sig end end
+ module Term0 : sig module Id : sig end end
+ module T : sig module Id : sig end end
type t = MkT(T).t
- end) ->
- sig module Id : sig end module Id2 = Id type t = T'.t end
+ end)
+ -> sig module Id : sig end module Id2 = Id type t = T'.t end
module IS :
sig
module Term0 : sig module Id : sig val x : string end end
module T = Term0
type t = MkT(T).t
end
-module M : sig module Id : sig end module Id2 = Id type t = IS.t end
+module M : sig module Id : sig end module Id2 = Id type t = IS.t end
|}]
module T : sig type t = int val compare : t -> t -> int end
type t = E of (MkT(T).t, MkT(T).t) eq
type u = t = E of (MkT(Term0).t, MkT(T).t) eq
- end) ->
+ end)
+ ->
sig
module Term0 : sig type t = int val compare : t -> t -> int end
module T : sig type t = int val compare : t -> t -> int end
15 | module rec M1 : S' with module Term0 := Asc and module T := Desc = M1;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M.t
- The types for field E are not equal.
+ Constructors do not match:
+ E of (MkT(M.T).t, MkT(M.T).t) eq
+ is not compatible with:
+ E of (MkT(Desc).t, MkT(Desc).t) eq
+ The types are not equal.
|}]
1 | module rec M1 : S with type x = int and type y = bool = M1;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M1.t
- The types for field E are not equal.
+ Constructors do not match:
+ E of M1.x
+ is not compatible with:
+ E of M1.y
+ The types are not equal.
|}]
let bool_of_int x =
1 | module rec M1 : S with type x = int and type y = bool = M1;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M1.t
- The types for field E are not equal.
+ Constructors do not match:
+ E of (M1.x, M1.x) eq
+ is not compatible with:
+ E of (M1.x, M1.y) eq
+ The types are not equal.
|}]
module M : sig module N : sig val x : int end end
module M : sig module N : sig ... end end
|}];;
+
+(* Shortcut notation for functors *)
+module type A
+module type B
+module type C
+module type D
+module type E
+module type F
+module Test(X: ((A->(B->C)->D) -> (E -> F))) = struct end
+[%%expect {|
+module type A
+module type B
+module type C
+module type D
+module type E
+module type F
+module Test : functor (X : (A -> (B -> C) -> D) -> E -> F) -> sig end
+|}]
+
+(* test reprinting of functors *)
+module type LongFunctor1 = functor (X : A) () (_ : B) () -> C -> D -> sig end
+[%%expect {|
+module type LongFunctor1 = functor (X : A) () (_ : B) () -> C -> D -> sig end
+|}]
+module type LongFunctor2 = functor (_ : A) () (_ : B) () -> C -> D -> sig end
+[%%expect {|
+module type LongFunctor2 = A -> functor () (_ : B) () -> C -> D -> sig end
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module M1 : sig
+ type t = {f0 : unit * unit * unit * int * unit * unit * unit;
+ f1 : unit * unit * unit * int * unit * unit * unit}
+end = struct
+ type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+ f1 : unit * unit * unit * string * unit * unit * unit}
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+6 | f1 : unit * unit * unit * string * unit * unit * unit}
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = {
+ f0 : unit * unit * unit * float * unit * unit * unit;
+ f1 : unit * unit * unit * string * unit * unit * unit;
+ }
+ end
+ is not included in
+ sig
+ type t = {
+ f0 : unit * unit * unit * int * unit * unit * unit;
+ f1 : unit * unit * unit * int * unit * unit * unit;
+ }
+ end
+ Type declarations do not match:
+ type t = {
+ f0 : unit * unit * unit * float * unit * unit * unit;
+ f1 : unit * unit * unit * string * unit * unit * unit;
+ }
+ is not included in
+ type t = {
+ f0 : unit * unit * unit * int * unit * unit * unit;
+ f1 : unit * unit * unit * int * unit * unit * unit;
+ }
+ Fields do not match:
+ f0 : unit * unit * unit * float * unit * unit * unit;
+ is not compatible with:
+ f0 : unit * unit * unit * int * unit * unit * unit;
+ The types are not equal.
+|}];;
+
+
+module M2 : sig
+ type t = {mutable f0 : unit * unit * unit * int * unit * unit * unit;
+ f1 : unit * unit * unit * int * unit * unit * unit}
+end = struct
+ type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+ f1 : unit * unit * unit * string * unit * unit * unit}
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+6 | f1 : unit * unit * unit * string * unit * unit * unit}
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = {
+ f0 : unit * unit * unit * float * unit * unit * unit;
+ f1 : unit * unit * unit * string * unit * unit * unit;
+ }
+ end
+ is not included in
+ sig
+ type t = {
+ mutable f0 : unit * unit * unit * int * unit * unit * unit;
+ f1 : unit * unit * unit * int * unit * unit * unit;
+ }
+ end
+ Type declarations do not match:
+ type t = {
+ f0 : unit * unit * unit * float * unit * unit * unit;
+ f1 : unit * unit * unit * string * unit * unit * unit;
+ }
+ is not included in
+ type t = {
+ mutable f0 : unit * unit * unit * int * unit * unit * unit;
+ f1 : unit * unit * unit * int * unit * unit * unit;
+ }
+ Fields do not match:
+ f0 : unit * unit * unit * float * unit * unit * unit;
+ is not compatible with:
+ mutable f0 : unit * unit * unit * int * unit * unit * unit;
+ The second is mutable and the first is not.
+|}];;
+
+module M3 : sig
+ type t = {f0 : unit}
+end = struct
+ type t = {f1 : unit}
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = {f1 : unit}
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = { f1 : unit; } end
+ is not included in
+ sig type t = { f0 : unit; } end
+ Type declarations do not match:
+ type t = { f1 : unit; }
+ is not included in
+ type t = { f0 : unit; }
+ Fields number 1 have different names, f1 and f0.
+|}];;
+
+module M4 : sig
+ type t = {f0 : unit; f1 : unit}
+end = struct
+ type t = {f0 : unit}
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = {f0 : unit}
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = { f0 : unit; } end
+ is not included in
+ sig type t = { f0 : unit; f1 : unit; } end
+ Type declarations do not match:
+ type t = { f0 : unit; }
+ is not included in
+ type t = { f0 : unit; f1 : unit; }
+ The field f1 is only present in the second declaration.
+|}];;
end;;
[%%expect{|
module F :
- functor (X : sig end) ->
+ functor (X : sig end) ->
sig
type s = private [ `Bar of 'a | `Foo ] as 'a
val from : M.t -> s
--- /dev/null
+(* TEST
+ * expect
+ *)
+
+module M1 : sig
+ type t =
+ | Foo of int * int
+end = struct
+ type t =
+ | Foo of float * int
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t =
+6 | | Foo of float * int
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo of float * int end
+ is not included in
+ sig type t = Foo of int * int end
+ Type declarations do not match:
+ type t = Foo of float * int
+ is not included in
+ type t = Foo of int * int
+ Constructors do not match:
+ Foo of float * int
+ is not compatible with:
+ Foo of int * int
+ The types are not equal.
+|}];;
+
+module M2 : sig
+ type t =
+ | Foo of int * int
+end = struct
+ type t =
+ | Foo of float
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t =
+6 | | Foo of float
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo of float end
+ is not included in
+ sig type t = Foo of int * int end
+ Type declarations do not match:
+ type t = Foo of float
+ is not included in
+ type t = Foo of int * int
+ Constructors do not match:
+ Foo of float
+ is not compatible with:
+ Foo of int * int
+ They have different arities.
+|}];;
+
+module M3 : sig
+ type t =
+ | Foo of {x : int; y : int}
+end = struct
+ type t =
+ | Foo of {x : float; y : int}
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t =
+6 | | Foo of {x : float; y : int}
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo of { x : float; y : int; } end
+ is not included in
+ sig type t = Foo of { x : int; y : int; } end
+ Type declarations do not match:
+ type t = Foo of { x : float; y : int; }
+ is not included in
+ type t = Foo of { x : int; y : int; }
+ Constructors do not match:
+ Foo of { x : float; y : int; }
+ is not compatible with:
+ Foo of { x : int; y : int; }
+ Fields do not match:
+ x : float;
+ is not compatible with:
+ x : int;
+ The types are not equal.
+|}];;
+
+module M4 : sig
+ type t =
+ | Foo of {x : int; y : int}
+end = struct
+ type t =
+ | Foo of float
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t =
+6 | | Foo of float
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo of float end
+ is not included in
+ sig type t = Foo of { x : int; y : int; } end
+ Type declarations do not match:
+ type t = Foo of float
+ is not included in
+ type t = Foo of { x : int; y : int; }
+ Constructors do not match:
+ Foo of float
+ is not compatible with:
+ Foo of { x : int; y : int; }
+ The second uses inline records and the first doesn't.
+|}];;
+
+module M5 : sig
+ type 'a t =
+ | Foo : int -> int t
+end = struct
+ type 'a t =
+ | Foo of 'a
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type 'a t =
+6 | | Foo of 'a
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type 'a t = Foo of 'a end
+ is not included in
+ sig type 'a t = Foo : int -> int t end
+ Type declarations do not match:
+ type 'a t = Foo of 'a
+ is not included in
+ type 'a t = Foo : int -> int t
+ Constructors do not match:
+ Foo of 'a
+ is not compatible with:
+ Foo : int -> int t
+ The second has explicit return type and the first doesn't.
+|}];;
+
+module M : sig
+ type ('a, 'b) t = A of 'a
+end = struct
+ type ('a, 'b) t = A of 'b
+end;;
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type ('a, 'b) t = A of 'b
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type ('a, 'b) t = A of 'b end
+ is not included in
+ sig type ('a, 'b) t = A of 'a end
+ Type declarations do not match:
+ type ('a, 'b) t = A of 'b
+ is not included in
+ type ('a, 'b) t = A of 'a
+ Constructors do not match:
+ A of 'b
+ is not compatible with:
+ A of 'a
+ The types are not equal.
+|}];;
+
+module M : sig
+ type ('a, 'b) t = A of 'a
+end = struct
+ type ('b, 'a) t = A of 'a
+end;;
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type ('b, 'a) t = A of 'a
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type ('b, 'a) t = A of 'a end
+ is not included in
+ sig type ('a, 'b) t = A of 'a end
+ Type declarations do not match:
+ type ('b, 'a) t = A of 'a
+ is not included in
+ type ('a, 'b) t = A of 'a
+ Constructors do not match:
+ A of 'a
+ is not compatible with:
+ A of 'a
+ The types are not equal.
+|}];;
+++ /dev/null
-pr6372.ml
-pr7325.ml
-pr7563.ml
--- /dev/null
+(* TEST
+ flags="-annot"
+ modules="a.ml"
+ *)
+
+(* Test interference between inline record path
+ [a.A] and the [a.ml] compilation unit *)
+type 'x a = A of { x: int }
+let v = A { x = 0 }
+++ /dev/null
-pr3968_bad.ml
-pr4018_bad.ml
-pr4435_bad.ml
-pr4766_ok.ml
-pr4824_ok.ml
-pr4824a_bad.ml
-pr5156_ok.ml
-pr7284_bad.ml
-pr7293_ok.ml
-woodyatt_ok.ml
-yamagata021012_ok.ml
module F(X : sig end) =
struct type t = int let _ = (x : < m : t> list ref) end;;
[%%expect{|
-module F : functor (X : sig end) -> sig type t = int end
+module F : functor (X : sig end) -> sig type t = int end
|}];;
x;;
[%%expect{|
class c : unit -> object method m : int end
|}];;
-(* Marshaling (cf. PR#5436) *)
-
-let r = ref 0;;
-[%%expect{|
-val r : int ref = {contents = 0}
-|}];;
-let id o = Oo.id o - !r;;
-[%%expect{|
-val id : < .. > -> int = <fun>
-|}];;
-r := Oo.id (object end);;
-[%%expect{|
-- : unit = ()
-|}];;
-id (object end);;
-[%%expect{|
-- : int = 1
-|}];;
-id (object end);;
-[%%expect{|
-- : int = 2
-|}];;
-let o = object end in
- let s = Marshal.to_string o [] in
- let o' : < > = Marshal.from_string s 0 in
- let o'' : < > = Marshal.from_string s 0 in
- (id o, id o', id o'');;
-[%%expect{|
-- : int * int * int = (3, 4, 5)
-|}];;
-
-let o = object val x = 33 method m = x end in
- let s = Marshal.to_string o [Marshal.Closures] in
- let o' : <m:int> = Marshal.from_string s 0 in
- let o'' : <m:int> = Marshal.from_string s 0 in
- (id o, id o', id o'', o#m, o'#m);;
-[%%expect{|
-- : int * int * int * int * int = (6, 7, 8, 33, 33)
-|}];;
-
-let o = object val x = 33 val y = 44 method m = x end in
- let s = Marshal.to_string (o,o) [Marshal.Closures] in
- let (o1, o2) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
- let (o3, o4) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
- (id o, id o1, id o2, id o3, id o4, o#m, o1#m);;
-[%%expect{|
-- : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33)
-|}];;
-
(* Recursion (cf. PR#5291) *)
class a = let _ = new b in object end
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed
|}];;
+
+class a = object val x = 3 val y = x + 2 end;;
+[%%expect{|
+Line 1, characters 35-36:
+1 | class a = object val x = 3 val y = x + 2 end;;
+ ^
+Error: The instance variable x
+ cannot be accessed from the definition of another instance variable
+|}];;
+
+class a = object (self) val x = self#m method m = 3 end;;
+[%%expect{|
+Line 1, characters 32-36:
+1 | class a = object (self) val x = self#m method m = 3 end;;
+ ^^^^
+Error: The self variable self
+ cannot be accessed from the definition of an instance variable
+|}];;
+
+class a = object method m = 3 end
+class b = object inherit a as super val x = super#m end;;
+[%%expect{|
+class a : object method m : int end
+Line 2, characters 44-49:
+2 | class b = object inherit a as super val x = super#m end;;
+ ^^^^^
+Error: The ancestor variable super
+ cannot be accessed from the definition of an instance variable
+|}];;
+++ /dev/null
-abstract_rows.ml
-dummy.ml
-errors.ml
-Exemples.ml
-open_in_classes.ml
-pr5545.ml
-pr5619_bad.ml
-pr5858.ml
-pr6123_bad.ml
-pr6383.ml
-pr6907_bad.ml
-self_cannot_be_closed.ml
-Tests.ml
--- /dev/null
+(* TEST
+ * expect
+*)
+
+class c =
+object (o)
+ method foo = o
+end;;
+[%%expect {|
+class c : object ('a) method foo : 'a end
+|}]
+
+class d =
+object (o) inherit c
+ method bar = fun () ->
+ let o = List.fold_right (fun _ o -> o#foo) [] o in
+ let o = match () with () -> o in o
+end;;
+[%%expect {|
+class d : object ('a) method bar : unit -> 'a method foo : 'a end
+|}]
+++ /dev/null
-pervasives_leitmotiv.ml
-pr4791.ml
-pr6323.ml
-pr7402.ml
-pr7620_bad.ml
+++ /dev/null
-pr5322_ok.ml
-pr5673_bad.ml
-pr5673_ok.ml
+++ /dev/null
-File "pr5673_bad.ml", line 31, characters 22-23:
-31 | let f (x : refer1) = (x : refer2)
- ^
-Error: This expression has type
- refer1 = < poly : 'a 'b 'c. ('b, 'c) #Classdef.cl2 as 'a >
- but an expression was expected of type
- refer2 = < poly : 'd 'b 'c. ('b, 'c) #Classdef.cl2 as 'd >
- Type ('b, 'c, ('b, 'c) Classdef.cl1) Classdef.cl0 = < >
- is not compatible with type
- ('b0, 'c0, ('b0, 'c0) Classdef.cl1) Classdef.cl0
- Type < m : 'b -> 'c -> int; .. > is not compatible with type
- ('b, 'c) Classdef.cl1 =
- < m : 'b -> 'c -> int; raise_trouble : int -> 'b >
- The universal variable 'b would escape its scope
+++ /dev/null
-(* TEST
-flags = " -w a "
-ocamlc_byte_exit_status = "2"
-* setup-ocamlc.byte-build-env
-** ocamlc.byte
-*** check-ocamlc.byte-output
-*)
-
-module Classdef = struct
- class virtual ['a, 'b, 'c] cl0 =
- object
- constraint 'c = < m : 'a -> 'b -> int; .. >
- end
-
- class virtual ['a, 'b] cl1 =
- object
- method virtual raise_trouble : int -> 'a
- method virtual m : 'a -> 'b -> int
- end
-
- class virtual ['a, 'b] cl2 =
- object
- method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0
- end
-end
-
-type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
-type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
-
-(* Actually this should succeed ... *)
-let f (x : refer1) = (x : refer2)
end = struct
type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
end
+
+type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+
+(* Now this works too *)
+let f (x : refer1) = (x : refer2)
--- /dev/null
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module Order = struct
+ module type Total = sig
+ type t
+ val compare: t -> t -> int
+ end
+end
+
+module type Profile = sig
+ module Priority: Order.Total
+
+ class type ['level] prioritizer = object
+ method code: 'level -> Priority.t
+ method tag: 'level -> string
+ end
+
+ class ['level] event:
+ 'level #prioritizer -> 'level -> string ->
+ object
+ method prioritizer: 'level prioritizer
+ method level: 'level
+ method message: string
+ end
+
+ class type ['event] archiver = object
+ constraint 'event = 'level #event
+ method emit: 'event -> unit
+ end
+
+ class virtual ['archiver] agent:
+ 'level #prioritizer -> 'level -> 'archiver list ->
+ object
+ constraint 'event = 'level #event
+ constraint 'archiver = 'event #archiver
+ val mutable archivers_: 'archiver list
+ val mutable limit_: Priority.t
+ method virtual private event: 'level -> string -> 'event
+ method setlimit: 'level -> unit
+ method enabled: 'level -> bool
+ method private put: 'a 'b. 'level -> ('event -> 'b) -> ('a, unit, string, string, string, 'b) format6 -> 'a
+ end
+end
+
+module Create(P: Order.Total) = struct
+ module Priority = P
+
+ class type ['level] prioritizer = object
+ method code: 'level -> Priority.t
+ method tag: 'level -> string
+ end
+
+ class ['level] event prioritizer level message =
+ let prioritizer = (prioritizer :> 'level prioritizer) in
+ object
+ method prioritizer = prioritizer
+ method level: 'level = level
+ method message: string = message
+ end
+
+ class type ['event] archiver = object
+ constraint 'event = 'level #event
+ method emit: 'event -> unit
+ end
+
+ class virtual ['archiver] agent prioritizer limit archivers =
+ let _ = (prioritizer :> 'level prioritizer) in
+ let _ = (archivers :> 'archiver list) in
+ object(self:'self)
+ constraint 'event = 'level #event
+ constraint 'archiver = 'event #archiver
+
+ val mutable archivers_ = archivers
+ val mutable limit_ = prioritizer#code limit
+
+ method virtual private event: 'level -> string -> 'event
+
+ method setlimit limit = limit_ <- prioritizer#code limit
+ method enabled limit = prioritizer#code limit >= limit_
+
+ method private put:
+ type a b. 'level -> ('event -> b) ->
+ (a, unit, string, string, string, b) format6 -> a
+ = fun level cont ->
+ let f message =
+ let e = self#event level message in
+ if self#enabled level then
+ List.iter (fun j -> j#emit e) archivers_;
+ cont e
+ in
+ Printf.kprintf f
+ end
+end
+
+module Basic = struct
+ include Create(struct type t = int let compare a b = b - a end)
+
+ type invalid = [ `Invalid ]
+ type fail = [ `Fail ]
+ type error = [ `Error ]
+ type warn = [ `Warn ]
+ type notice = [ `Notice ]
+ type info = [ `Info ]
+ type debug = [ `Debug ]
+
+ type basic = [ invalid | fail | error | warn | notice | info | debug ]
+ type enable = [ `None | `All ]
+ type level = [ basic | enable ]
+end
+
+class ['level] basic_prioritizer =
+ object(_:'self)
+ constraint 'self = 'level #Basic.prioritizer
+ constraint 'level = [> Basic.level ]
+
+ method code = function
+ | `All -> max_int
+ | `Invalid -> 7000
+ | `Fail -> 6000
+ | `Error -> 5000
+ | `Warn -> 4000
+ | `Notice -> 3000
+ | `Info -> 2000
+ | `Debug -> 1000
+ | `None -> min_int
+ | _ -> invalid_arg "Oni_cf_journal: no code defined for priority!"
+
+ method tag =
+ let invalid_ = "INVALID" in
+ let fail_ = "FAIL" in
+ let error_ = "ERROR" in
+ let warn_ = "WARN" in
+ let notice_ = "NOTICE" in
+ let info_ = "INFO" in
+ let debug_ = "DEBUG" in
+ function
+ | `Invalid -> invalid_
+ | `Fail -> fail_
+ | `Error -> error_
+ | `Warn -> warn_
+ | `Notice -> notice_
+ | `Info -> info_
+ | `Debug -> debug_
+ | _ -> invalid_arg "Oni_cf_journal: no tag defined for priority!"
+ end
+
+class ['event] basic_channel_archiver channel = object
+ constraint 'self = 'event #Basic.archiver
+ constraint 'level = [> Basic.level ]
+ constraint 'event = 'level #Basic.event
+
+ method channel = channel
+
+ method emit e =
+ let _ = (e :> 'event) in
+ let n = e#level in
+ let p = e#prioritizer in
+ if (p#code `Fail) - (p#code e#level) > 0 then begin
+ let tag = p#tag n in
+ let m = e#message in
+ Printf.fprintf channel "%s: %s\n" tag m;
+ flush channel
+ end
+end
+
+class virtual ['archiver] basic_agent prioritizer limit archivers =
+ let _ = (prioritizer :> 'level basic_prioritizer) in
+ (*
+ let _ = (limit : 'level) in
+ let _ = (archivers : 'archiver list) in
+ *)
+ object(self)
+ constraint 'level = [> Basic.level ]
+ constraint 'event = 'level #Basic.event
+ constraint 'archiver = 'event #Basic.archiver
+ inherit ['archiver] Basic.agent prioritizer limit archivers (* as super *)
+
+ (*
+ method! private put:
+ 'a 'b. 'level -> ('event -> 'b) ->
+ ('a, unit, string, 'b) format4 -> 'a = super#put
+ *)
+
+ method invalid:
+ 'a 'b. ('a, unit, string, string, string, 'b) format6 -> 'a =
+ self#put `Invalid (fun x -> invalid_arg x#message)
+
+ method fail:
+ 'a 'b. ('a, unit, string, string, string, 'b) format6 -> 'a =
+ self#put `Fail (fun x -> failwith x#message)
+
+ method error:
+ 'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+ self#put `Error ignore
+
+ method warn:
+ 'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+ self#put `Warn ignore
+
+ method notice:
+ 'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+ self#put `Notice ignore
+
+ method info:
+ 'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+ self#put `Info ignore
+
+ method debug:
+ 'a. ('a, unit, string, string, string, bool) format6 -> 'a =
+ self#put `Debug (fun _ -> true)
+ end
^
Error: This expression has type < a : 'a; b : 'a >
but an expression was expected of type < a : 'a; b : 'a0. 'a0 >
- The method b has type 'a, but the expected method type was 'a0. 'a0
- The universal variable 'a0 would escape its scope
+ The method b has type 'a, but the expected method type was 'a. 'a
+ The universal variable 'a would escape its scope
|}]
Error: This expression has type < f : 'a -> int >
but an expression was expected of type t_a
The method f has type 'a -> int, but the expected method type was
- 'a0. 'a0 -> int
- The universal variable 'a0 would escape its scope
+ 'a. 'a -> int
+ The universal variable 'a would escape its scope
|}
]
Error: This expression has type 'a v but an expression was expected of type
uv
The method f has type 'a -> int, but the expected method type was
- 'a0. 'a0 -> int
- The universal variable 'a0 would escape its scope
+ 'a. 'a -> int
+ The universal variable 'a would escape its scope
+|}]
+
+(* Issue #8702: row types unified with universally quantified types*)
+
+let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x
+[%%expect {|
+Line 1, characters 48-49:
+1 | let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x
+ ^
+Error: This expression has type [> `A ]
+ but an expression was expected of type [ `A ]
+ The first variant type is bound to the universal type variable 'a,
+ it cannot be closed
+|}]
+
+let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x
+[%%expect {|
+Line 1, characters 48-49:
+1 | let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x
+ ^
+Error: This expression has type [ `A ] but an expression was expected of type
+ [> `A ]
+ The second variant type is bound to the universal type variable 'a,
+ it cannot be closed
+|}]
+
+
+let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x
+[%%expect {|
+Line 1, characters 53-54:
+1 | let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x
+ ^
+Error: This expression has type [ `A | `B ]
+ but an expression was expected of type [> `A ]
+ The second variant type is bound to the universal type variable 'a,
+ it cannot be closed
+|}]
+
+
+let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x
+[%%expect {|
+Line 1, characters 59-60:
+1 | let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x
+ ^
+Error: This expression has type [> `A | `B | `C ]
+ but an expression was expected of type [> `A ]
+ The second variant type is bound to the universal type variable 'a,
+ it may not allow the tag(s) `B, `C
|}]
+++ /dev/null
-error_messages.ml
-poly.ml
;;
[%%expect {|
type 'a t = unit
-class o : object method x : [> `A ] t -> unit end
+class o : object method x : unit -> unit end
|}];;
class c = object method m = new d () end and d ?(x=0) () = object end;;
Error: This expression has type < m : 'a. 'a * < m : 'a * 'b > > as 'b
but an expression was expected of type
< m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) >
- The method m has type 'a. 'a * 'd, but the expected method type was
- 'c. 'c * 'd
+ The method m has type
+ 'a. 'a * (< m : 'a * < m : 'c. 'c * 'b > > as 'b),
+ but the expected method type was
+ 'c. 'c * < m : 'a * < m : 'c. 'b > > as 'b
The universal variable 'a would escape its scope
|}];;
^^^^^^
Error: This expression has type [> `Int of int ]
but an expression was expected of type [< `Int of int ]
- Types for tag `Int are incompatible
+ The second variant type is bound to the universal type variable 'a,
+ it may not allow the tag(s) `Int
|}];;
(* Yet another example *)
[%%expect{|
type u
type 'a t = u
-val c : (u -> u) -> < apply : 'a. 'a t -> 'a t > = <fun>
+val c : (u -> u) -> < apply : 'a. u -> u > = <fun>
|}]
(* PR#7496 *)
[%%expect{|
val x : [ `Foo of 'a list t ] = `Foo []
|}]
+
+(* generalize spine of inherited methods too *)
+
+class c = object (self) method m ?(x=0) () = x method n = self#m () end;;
+class d = object (self) inherit c method n' = self#m () end;;
+[%%expect{|
+class c : object method m : ?x:int -> unit -> int method n : int end
+class d :
+ object method m : ?x:int -> unit -> int method n : int method n' : int end
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module M = struct
+ type ('a, 'b) elt = 'a
+
+ type 'a iter = { f : 'b.('a, 'b) elt -> unit }
+
+ let promote (f : 'a -> unit) =
+ let f : 'b.('a, 'b) elt -> unit = fun x -> f x in
+ { f }
+end
+[%%expect{|
+module M :
+ sig
+ type ('a, 'b) elt = 'a
+ type 'a iter = { f : 'b. 'a -> unit; }
+ val promote : ('a -> unit) -> 'a iter
+ end
+|}]
+
+module M' : sig
+ type ('a, 'b) elt
+ type 'a iter = { f : 'b.('a, 'b) elt -> unit }
+end = M
+[%%expect{|
+module M' :
+ sig type ('a, 'b) elt type 'a iter = { f : 'b. ('a, 'b) elt -> unit; } end
+|}]
+
+type 'a t = int
+let test : 'a. int -> 'a t = fun i -> i;;
+[%%expect{|
+type 'a t = int
+val test : int -> int = <fun>
+|}]
+++ /dev/null
-pr3918c.ml
+++ /dev/null
-pr4775_ok.ml
-pr4933_ok.ml
-pr5057_ok.ml
-pr5057a_bad.ml
-pr7199_ok.ml
-pr7824.ml
-privrowsabate_ok.ml
+++ /dev/null
-pr5026_bad.ml
-pr5469_ok.ml
+++ /dev/null
-private.ml
module type S = sig module M : sig end module N = M end;;
[%%expect{|
-module type S = sig module M : sig end module N = M end
+module type S = sig module M : sig end module N = M end
|}];;
module rec M : S with module M := M = M;;
+++ /dev/null
-t01bad.ml
-t02bad.ml
-t03ok.ml
-t04bad.ml
-t05bad.ml
-t06ok.ml
-t07bad.ml
-t08bad.ml
-t09bad.ml
-t10ok.ml
-t11bad.ml
-t12bad.ml
-t13ok.ml
-t14bad.ml
-t15bad.ml
-t16ok.ml
-t17ok.ml
-t18ok.ml
-t20ok.ml
-t21ok.ml
-t22ok.ml
-gpr1626.ml
+++ /dev/null
-recordarg.ml
+++ /dev/null
-pr5343_bad.ml
-pr6174_bad.ml
-pr6870_bad.ml
+++ /dev/null
-redefine_largefile.ml
-redefine_largefile_top.ml
+++ /dev/null
-gpr1223.ml
-pr5918.ml
-pr6836.ml
-pr7543.ml
-short-paths.ml
1 | let () = f (module N);;
^
Error: Signature mismatch:
- Modules do not match:
- sig type 'a t = 'a end
- is not included in
- sig type t = N.t end
+ Modules do not match: sig type 'a t = 'a end is not included in S
Type declarations do not match:
type 'a t = 'a
is not included in
- type t = N.t
+ type t
They have different arities.
sig type value type state type usert = X.combined end
val setglobal : V.state -> string -> V.value -> unit
val apply : V.value -> V.state -> V.value list -> V.value
- end) ->
- sig val init : C.V.state -> unit end
+ end)
+ -> sig val init : C.V.state -> unit end
end
module Weapon : sig type t end
module type WEAPON_LIB =
type combined
type t = t
val map : (combined -> t) * (t -> combined)
- end) ->
- USERCODE(TV).F
+ end)
+ -> USERCODE(TV).F
end
module type X = functor (X : CORE) -> BARECODE
module type X = CORE -> BARECODE
+++ /dev/null
-els.ml
-pr6371.ml
-pr6672.ml
+++ /dev/null
-sig_local_aliases.ml
-sig_local_aliases_syntax_errors.ml
-sigsubst.ml
-test_locations.ml
and u := int * int
end;;
[%%expect{|
-module type AcceptAnd = sig end
+module type AcceptAnd = sig end
|}]
module type RejectAnd = sig
module type S = sig type 'a t end with type 'a t := unit
[%%expect {|
-module type S = sig end
+module type S = sig end
|}]
module type S = sig
5 | end with type M2.t := int
Error: This `with' constraint on M2.t makes the applicative functor
type Id(M2).t ill-typed in the constrained signature:
- Modules do not match: sig end is not included in sig type t end
+ Modules do not match: sig end is not included in sig type t end
The type `t' is required but not provided
|}]
end with module M.N := A
[%%expect {|
module A : sig module P : sig type t val x : int end end
-module type S = sig module M : sig end type t = A.P.t end
+module type S = sig module M : sig end type t = A.P.t end
|}]
(* Same as for types, not all substitutions are accepted *)
+++ /dev/null
-newtype.ml
+++ /dev/null
-test.ml
-test_flat.ml
-test_no_flat.ml
Line 2, characters 0-34:
2 | external id : i -> i = "%identity";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type i, which is unannotated and
-unboxable. The representation of such types may change in future
-versions. You should annotate the declaration of i with [@@boxed]
-or [@@unboxed].
+Warning 61: This primitive declaration uses type i, whose representation
+may be either boxed or unboxed. Without an annotation to indicate
+which representation is intended, the boxed representation has been
+selected by default. This default choice may change in future
+versions of the compiler, breaking the primitive implementation.
+You should explicitly annotate the declaration of i
+with [@@boxed] or [@@unboxed], so that its external interface
+remains stable in the future.
external id : i -> i = "%identity"
|}];;
Line 3, characters 0-34:
3 | external id : i -> j = "%identity";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type i, which is unannotated and
-unboxable. The representation of such types may change in future
-versions. You should annotate the declaration of i with [@@boxed]
-or [@@unboxed].
+Warning 61: This primitive declaration uses type i, whose representation
+may be either boxed or unboxed. Without an annotation to indicate
+which representation is intended, the boxed representation has been
+selected by default. This default choice may change in future
+versions of the compiler, breaking the primitive implementation.
+You should explicitly annotate the declaration of i
+with [@@boxed] or [@@unboxed], so that its external interface
+remains stable in the future.
Line 3, characters 0-34:
3 | external id : i -> j = "%identity";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type j, which is unannotated and
-unboxable. The representation of such types may change in future
-versions. You should annotate the declaration of j with [@@boxed]
-or [@@unboxed].
+Warning 61: This primitive declaration uses type j, whose representation
+may be either boxed or unboxed. Without an annotation to indicate
+which representation is intended, the boxed representation has been
+selected by default. This default choice may change in future
+versions of the compiler, breaking the primitive implementation.
+You should explicitly annotate the declaration of j
+with [@@boxed] or [@@unboxed], so that its external interface
+remains stable in the future.
external id : i -> j = "%identity"
|}];;
| _ -> 2
;;
[%%expect {|
+Line 2, characters 12-13:
+2 | | (module M:S),_,(1,_)
+ ^
+Warning 60: unused module M.
val not_ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
|}]
--- /dev/null
+(* TEST
+ flags = " -w -a+21 "
+ * expect
+*)
+
+let () = (let module L = List in raise Exit); () ;;
+[%%expect {|
+Line 1, characters 33-43:
+1 | let () = (let module L = List in raise Exit); () ;;
+ ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+let () = (let exception E in raise Exit); ();;
+[%%expect {|
+Line 1, characters 29-39:
+1 | let () = (let exception E in raise Exit); ();;
+ ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+let () = (raise Exit : _); ();;
+[%%expect {|
+Line 1, characters 10-20:
+1 | let () = (raise Exit : _); ();;
+ ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+let () = (let open Stdlib in raise Exit); ();;
+[%%expect {|
+Line 1, characters 29-39:
+1 | let () = (let open Stdlib in raise Exit); ();;
+ ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+++ /dev/null
-ambiguous_guarded_disjunction.ml
-application.ml
-coercions.ml
-exhaustiveness.ml
-pr5892.ml
-pr6587.ml
-pr6872.ml
-pr7085.ml
-pr7115.ml
-pr7261.ml
-pr7297.ml
-pr7553.ml
-records.ml
-unused_rec.ml
-unused_types.ml
-open_warnings.ml
3 | open M (* unused open *)
^^^^^^
Warning 33: unused open M.
-module T1 : sig end
+module T1 : sig end
|}]
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
Warning 34: unused type t0.
-Line 2, characters 2-13:
+Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
- ^^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
-module T3 : sig end
+module T3 : sig end
|}]
module T4 : sig end = struct
3 | module M = struct type t = A end (* unused type and constructor *)
^^^^^^^^^^
Warning 34: unused type t.
-Line 3, characters 20-30:
+Line 3, characters 29-30:
3 | module M = struct type t = A end (* unused type and constructor *)
- ^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
Line 4, characters 2-8:
4 | open M (* unused open; no shadowing (A below refers to the one in t0) *)
^^^^^^
Warning 33: unused open M.
-module T4 : sig end
+module T4 : sig end
|}]
module T5 : sig end = struct
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
Warning 34: unused type t0.
-Line 2, characters 2-13:
+Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
- ^^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
-module T5 : sig end
+module T5 : sig end
|}]
3 | open! M (* unused open *)
^^^^^^^
Warning 66: unused open! M.
-module T1_bis : sig end
+module T1_bis : sig end
|}]
module T2_bis : sig type s end = struct
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
Warning 34: unused type t0.
-Line 2, characters 2-13:
+Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
- ^^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
-module T3_bis : sig end
+module T3_bis : sig end
|}]
module T4_bis : sig end = struct
3 | module M = struct type t = A end (* unused type and constructor *)
^^^^^^^^^^
Warning 34: unused type t.
-Line 3, characters 20-30:
+Line 3, characters 29-30:
3 | module M = struct type t = A end (* unused type and constructor *)
- ^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
Line 4, characters 2-9:
4 | open! M (* unused open; no shadowing (A below refers to the one in t0) *)
^^^^^^^
Warning 66: unused open! M.
-module T4_bis : sig end
+module T4_bis : sig end
|}]
module T5_bis : sig end = struct
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
Warning 34: unused type t0.
-Line 2, characters 2-13:
+Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
- ^^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
-module T5_bis : sig end
+module T5_bis : sig end
+|}]
+
+
+module T6 : sig end = struct
+ (* GPR9170 *)
+ module M = struct
+ type t = [`A | `B]
+ end
+ module type S = sig
+ open M
+ val f: #t -> unit
+ end
+ let _ = fun ((module S : S)) -> S.f `A
+end;;
+[%%expect {|
+Line 8, characters 11-13:
+8 | val f: #t -> unit
+ ^^
+Alert deprecated: old syntax for polymorphic variant type
+module T6 : sig end
+|}]
+
+module T7 : sig end = struct
+ (* GPR9170 *)
+ module M = struct
+ class type t = object end
+ end
+ module type S = sig
+ open M
+ val f: #t -> unit
+ end
+ let _ = fun ((module S : S)) -> S.f (object end)
+end;;
+[%%expect {|
+module T7 : sig end
+|}]
+
+module T8 : sig end = struct
+ (* GPR9170 *)
+ module M = struct
+ class t = object end
+ end
+ module type S = sig
+ open M
+ val f: #t -> unit
+ end
+ let _ = fun ((module S : S)) -> S.f (object end)
+end;;
+[%%expect {|
+module T8 : sig end
|}]
2 | let _f ~x (* x unused argument *) = function
^
Warning 27: unused variable x.
-module X1 : sig end
+module X1 : sig end
|}]
module X2 : sig end = struct
2 | let x = 42 (* unused value *)
^
Warning 32: unused value x.
-module X2 : sig end
+module X2 : sig end
|}]
module X3 : sig end = struct
3 | open O (* unused open *)
^^^^^^
Warning 33: unused open O.
-module X3 : sig end
+module X3 : sig end
|}]
2 | open A
^^^^^^
Warning 33: unused open A.
-module rec C : sig end
+module rec C : sig end
|}]
module rec D : sig
4 | open A
^^^^^^
Warning 33: unused open A.
-module rec D : sig module M : sig module X : sig end end end
+module rec D : sig module M : sig module X : sig end end end
|}]
--- /dev/null
+(* TEST
+ flags = " -w A "
+ * expect
+*)
+
+module Foo(Unused : sig end) = struct end;;
+[%%expect {|
+Line 1, characters 11-17:
+1 | module Foo(Unused : sig end) = struct end;;
+ ^^^^^^
+Warning 60: unused module Unused.
+module Foo : functor (Unused : sig end) -> sig end
+|}]
+
+module type S = functor (Unused : sig end) -> sig end;;
+[%%expect {|
+Line 1, characters 25-31:
+1 | module type S = functor (Unused : sig end) -> sig end;;
+ ^^^^^^
+Warning 67: unused functor parameter Unused.
+module type S = functor (Unused : sig end) -> sig end
+|}]
+
+module type S = sig
+ module M (Unused : sig end) : sig end
+end;;
+[%%expect{|
+Line 2, characters 12-18:
+2 | module M (Unused : sig end) : sig end
+ ^^^^^^
+Warning 67: unused functor parameter Unused.
+module type S = sig module M : functor (Unused : sig end) -> sig end end
+|}]
3 | type unused = int
^^^^^^^^^^^^^^^^^
Warning 34: unused type unused.
-module Unused : sig end
+module Unused : sig end
|}]
module Unused_nonrec : sig
4 | type nonrec unused = used
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 34: unused type unused.
-module Unused_nonrec : sig end
+module Unused_nonrec : sig end
|}]
module Unused_rec : sig
3 | type unused = A of unused
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 34: unused type unused.
-Line 3, characters 2-27:
+Line 3, characters 16-27:
3 | type unused = A of unused
- ^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^
Warning 37: unused constructor A.
-module Unused_rec : sig end
+module Unused_rec : sig end
+|}]
+
+module Used_constructor : sig
+ type t
+ val t : t
+end = struct
+ type t = T
+ let t = T
+end
+;;
+[%%expect {|
+module Used_constructor : sig type t val t : t end
+|}]
+
+module Unused_constructor : sig
+ type t
+end = struct
+ type t = T
+end
+;;
+[%%expect {|
+Line 4, characters 11-12:
+4 | type t = T
+ ^
+Warning 37: unused constructor T.
+module Unused_constructor : sig type t end
+|}]
+
+module Unused_constructor_outside_patterns : sig
+ type t
+ val nothing : t -> unit
+end = struct
+ type t = T
+ let nothing = function
+ | T -> ()
+end
+;;
+[%%expect {|
+Line 5, characters 11-12:
+5 | type t = T
+ ^
+Warning 37: constructor T is never used to build values.
+(However, this constructor appears in patterns.)
+module Unused_constructor_outside_patterns :
+ sig type t val nothing : t -> unit end
+|}]
+
+module Unused_constructor_exported_private : sig
+ type t = private T
+end = struct
+ type t = T
+end
+;;
+[%%expect {|
+Line 4, characters 11-12:
+4 | type t = T
+ ^
+Warning 37: constructor T is never used to build values.
+Its type is exported as a private type.
+module Unused_constructor_exported_private : sig type t = private T end
+|}]
+
+module Used_private_constructor : sig
+ type t
+ val nothing : t -> unit
+end = struct
+ type t = private T
+ let nothing = function
+ | T -> ()
+end
+;;
+[%%expect {|
+module Used_private_constructor : sig type t val nothing : t -> unit end
+|}]
+
+module Unused_private_constructor : sig
+ type t
+end = struct
+ type t = private T
+end
+;;
+[%%expect {|
+Line 4, characters 19-20:
+4 | type t = private T
+ ^
+Warning 37: unused constructor T.
+module Unused_private_constructor : sig type t end
+|}]
+
+module Exported_private_constructor : sig
+ type t = private T
+end = struct
+ type t = private T
+end
+;;
+[%%expect {|
+module Exported_private_constructor : sig type t = private T end
+|}]
+
+module Used_exception : sig
+ val e : exn
+end = struct
+ exception Somebody_uses_me
+ let e = Somebody_uses_me
+end
+;;
+[%%expect {|
+module Used_exception : sig val e : exn end
+|}]
+
+module Used_extension_constructor : sig
+ type t
+ val t : t
+end = struct
+ type t = ..
+ type t += Somebody_uses_me
+ let t = Somebody_uses_me
+end
+;;
+[%%expect {|
+module Used_extension_constructor : sig type t val t : t end
|}]
module Unused_exception : sig
3 | exception Nobody_uses_me
^^^^^^^^^^^^^^^^^^^^^^^^
Warning 38: unused exception Nobody_uses_me
-module Unused_exception : sig end
+module Unused_exception : sig end
|}]
module Unused_extension_constructor : sig
sig type t = .. val falsity : t -> bool end
|}]
-module Unused_private_exception : sig
+module Unused_exception_exported_private : sig
type exn += private Private_exn
end = struct
exception Private_exn
^^^^^^^^^^^^^^^^^^^^^
Warning 38: exception Private_exn is never used to build values.
It is exported or rebound as a private extension.
-module Unused_private_exception : sig type exn += private Private_exn end
+module Unused_exception_exported_private :
+ sig type exn += private Private_exn end
|}]
-module Unused_private_extension : sig
+module Unused_extension_exported_private : sig
type t = ..
type t += private Private_ext
end = struct
^^^^^^^^^^^
Warning 38: extension constructor Private_ext is never used to build values.
It is exported or rebound as a private extension.
-module Unused_private_extension :
+module Unused_extension_exported_private :
sig type t = .. type t += private Private_ext end
|}]
+module Used_private_extension : sig
+ type t
+ val nothing : t -> unit
+end = struct
+ type t = ..
+ type t += private Private_ext
+ let nothing = function
+ | Private_ext | _ -> ()
+end
+;;
+[%%expect {|
+module Used_private_extension : sig type t val nothing : t -> unit end
+|}]
+
+module Unused_private_extension : sig
+ type t
+end = struct
+ type t = ..
+ type t += private Private_ext
+end
+;;
+[%%expect {|
+Line 5, characters 20-31:
+5 | type t += private Private_ext
+ ^^^^^^^^^^^
+Warning 38: unused extension constructor Private_ext
+module Unused_private_extension : sig type t end
+|}]
+
+module Exported_private_extension : sig
+ type t = ..
+ type t += private Private_ext
+end = struct
+ type t = ..
+ type t += private Private_ext
+end
+;;
+[%%expect {|
+module Exported_private_extension :
+ sig type t = .. type t += private Private_ext end
+|}]
+
+
module Pr7438 : sig
end = struct
module type S = sig type t = private [> `Foo] end
sig type t = private [> `Foo | `Bar] include S with type t := t end
end;;
[%%expect {|
-module Pr7438 : sig end
+module Pr7438 : sig end
|}]
module Unused_type_disable_warning : sig
type t = A [@@warning "-34"]
end;;
[%%expect {|
-Line 3, characters 2-30:
+Line 3, characters 11-12:
3 | type t = A [@@warning "-34"]
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^
Warning 37: unused constructor A.
-module Unused_type_disable_warning : sig end
+module Unused_type_disable_warning : sig end
|}]
module Unused_constructor_disable_warning : sig
3 | type t = A [@@warning "-37"]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 34: unused type t.
-module Unused_constructor_disable_warning : sig end
+module Unused_constructor_disable_warning : sig end
|}]
+++ /dev/null
-edit_distance.ml
-overflow_detection.ml
-test_strongly_connected_components.ml
+++ /dev/null
-deprecated_module_assigment.ml
-deprecated_module.ml
-deprecated_module_use.ml
-w01.ml
-w03.ml
-w04_failure.ml
-w04.ml
-w06.ml
-w32b.ml
-w32.ml
-w33.ml
-w45.ml
-w47_inline.ml
-w50.ml
-w51_bis.ml
-w51.ml
-w52.ml
-w53.ml
-w54.ml
-w55.ml
-w58.ml
-w59.ml
-w60.ml
+File "w32.mli", line 12, characters 10-11:
+12 | module F (X : sig val x : int end) : sig end
+ ^
+Warning 67: unused functor parameter X.
+File "w32.mli", line 14, characters 10-11:
+14 | module G (X : sig val x : int end) : sig end
+ ^
+Warning 67: unused functor parameter X.
+File "w32.mli", line 16, characters 10-11:
+16 | module H (X : sig val x : int end) : sig val x : int end
+ ^
+Warning 67: unused functor parameter X.
File "w32.ml", line 40, characters 24-25:
40 | let[@warning "-32"] rec q x = x
^
63 | module F (X : sig val x : int end) = struct end
^^^^^^^^^^^
Warning 32: unused value x.
+File "w32.ml", line 63, characters 10-11:
+63 | module F (X : sig val x : int end) = struct end
+ ^
+Warning 60: unused module X.
File "w32.ml", line 65, characters 18-29:
65 | module G (X : sig val x : int end) = X
^^^^^^^^^^^
13 | module Q (M : sig type t end) = struct end
^^^^^^
Warning 34: unused type t.
+File "w32b.ml", line 13, characters 10-11:
+13 | module Q (M : sig type t end) = struct end
+ ^
+Warning 60: unused module M.
(* TEST
-flags = "-w A"
+flags = "-w A-60"
* setup-ocamlc.byte-build-env
** ocamlc.byte
--- /dev/null
+File "w60.ml", line 40, characters 13-14:
+40 | let module M = struct end in
+ ^
+Warning 60: unused module M.
(* TEST
-flags = "-w A"
+flags = "-w A-67"
* setup-ocamlc.byte-build-env
** ocamlc.byte
end
module O = M.N
+
+(***************)
+
+let () =
+ (* M is unused, but no warning was emitted before 4.10. *)
+ let module M = struct end in
+ ()
#* *
#**************************************************************************
-BASEDIR = ..
+TOPDIR = ../..
-ROOTDIR = ../..
+COMPILERLIBSDIR = $(TOPDIR)/compilerlibs
+
+RUNTIME_VARIANT ?=
+ASPPFLAGS ?=
+
+include $(TOPDIR)/Makefile.tools
-include $(ROOTDIR)/Makefile.config
expect_MAIN=expect_test
expect_PROG=$(expect_MAIN)$(EXE)
-expect_COMPFLAGS=-I $(OTOPDIR)/parsing -I $(OTOPDIR)/utils \
- -I $(OTOPDIR)/driver -I $(OTOPDIR)/typing -I $(OTOPDIR)/toplevel
-expect_LIBRARIES := $(addprefix $(ROOTDIR)/compilerlibs/,\
+expect_DIRS = parsing utils driver typing toplevel
+expect_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/,$(expect_DIRS))
+expect_LIBS := $(addprefix $(COMPILERLIBSDIR)/,\
ocamlcommon ocamlbytecomp ocamltoplevel)
-codegen_INCLUDES=\
- -I $(OTOPDIR)/parsing \
- -I $(OTOPDIR)/utils \
- -I $(OTOPDIR)/typing \
- -I $(OTOPDIR)/middle_end \
- -I $(OTOPDIR)/bytecomp \
- -I $(OTOPDIR)/lambda \
- -I $(OTOPDIR)/asmcomp
+codegen_PROG = codegen$(EXE)
+codegen_DIRS = parsing utils typing middle_end bytecomp lambda asmcomp
+codegen_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/, $(codegen_DIRS)) -w +40 -g
-codegen_OTHEROBJECTS=\
- $(OTOPDIR)/compilerlibs/ocamlcommon.cma \
- $(OTOPDIR)/compilerlibs/ocamloptcomp.cma
+codegen_LIBS = $(addprefix $(COMPILERLIBSDIR)/,\
+ ocamlcommon ocamloptcomp)
-codegen_OBJECTS=parsecmmaux.cmo parsecmm.cmo lexcmm.cmo codegen_main.cmo
+codegen_OBJECTS = $(addsuffix .cmo,\
+ parsecmmaux parsecmm lexcmm codegen_main)
-codegen_ADD_COMPFLAGS=$(codegen_INCLUDES) -w -40 -g
+tools := $(expect_PROG)
-targets := $(expect_PROG)
-
-ifneq "$(ARCH)" "none"
-targets += codegen
+ifeq "$(NATIVE_COMPILER)" "true"
+tools += $(codegen_PROG)
ifneq "$(CCOMPTYPE)-$(ARCH)" "msvc-amd64"
# The asmgen tests are not ported to MSVC64 yet
# so do not compile any arch-specific module
-targets += asmgen_$(ARCH).$(O)
+tools += asmgen_$(ARCH).$(O)
endif
endif
-all: $(targets)
-
-$(expect_PROG): $(expect_LIBRARIES:=.cma) $(expect_MAIN).cmo
- @$(OCAMLC) -linkall -o $@ $^
+all: $(tools)
-include $(BASEDIR)/makefiles/Makefile.common
+$(expect_PROG): $(expect_LIBS:=.cma) $(expect_MAIN).cmo
+ $(OCAMLC) -linkall -o $@ $^
-.PHONY: clean
-clean: defaultclean
- rm -f $(expect_PROG)
- rm -f codegen parsecmm.ml parsecmm.mli lexcmm.ml
-
-expect_test.cmo: COMPFLAGS=$(expect_COMPFLAGS)
+$(expect_PROG): COMPFLAGS = $(expect_OCAMLFLAGS)
-$(codegen_OBJECTS): ADD_COMPFLAGS = $(codegen_ADD_COMPFLAGS)
+$(codegen_PROG): COMPFLAGS = $(codegen_OCAMLFLAGS)
codegen_main.cmo: parsecmm.cmo
-codegen: $(codegen_OBJECTS)
- @$(OCAMLC) $(LINKFLAGS) -o $@ $(codegen_OTHEROBJECTS) $^
+$(codegen_PROG): $(codegen_OBJECTS)
+ $(OCAMLC) -o $@ $(codegen_LIBS:=.cma) $^
parsecmm.mli parsecmm.ml: parsecmm.mly
- @$(OCAMLYACC) -q parsecmm.mly
+ $(OCAMLYACC) -q parsecmm.mly
lexcmm.ml: lexcmm.mll
- @$(OCAMLLEX) -q lexcmm.mll
+ $(OCAMLLEX) -q lexcmm.mll
+
+parsecmmaux.cmo: parsecmmaux.cmi
+
+lexcmm.cmo: lexcmm.cmi
+
+parsecmm.cmo: parsecmm.cmi
asmgen_i386.obj: asmgen_i386nt.asm
@set -o pipefail ; \
$(ASM) $@ $^ | tail -n +2
+
+%.cmi: %.mli
+ $(OCAMLC) -c $<
+
+%.cmo: %.ml
+ $(OCAMLC) -c $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) -c $<
+
+%.$(O): %.S
+ $(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $@ $<
+
+.PHONY: clean
+clean:
+ rm -f *.cm* *.$(O)
+ rm -f $(tools)
+ rm -f parsecmm.ml parsecmm.mli lexcmm.ml
G(caml_c_call):
jmp *%eax
- .comm G(caml_exception_pointer), 4
- .comm G(young_ptr), 4
- .comm G(young_start), 4
+ .comm G(Caml_state), 4
/* Some tests are designed to cause registers to spill; on
* x86 we require the caml_extra_params symbol from the RTS. */
int 3
.DATA
- PUBLIC _caml_exception_pointer
-_caml_exception_pointer dword 0
- PUBLIC _caml_young_ptr
-_caml_young_ptr dword 0
- PUBLIC _caml_young_limit
-_caml_young_limit dword 0
+ PUBLIC _Caml_state
+_Caml_state dword 0
END
Emit.begin_assembly();
let ic = open_in filename in
let lb = Lexing.from_channel ic in
- lb.Lexing.lex_curr_p <- { lb.Lexing.lex_curr_p with pos_fname = filename };
+ lb.Lexing.lex_curr_p <- Lexing.{ lb.lex_curr_p with pos_fname = filename };
try
while true do
Asmgen.compile_phrase ~ppf_dump:Format.std_formatter
"-dcmm", Arg.Set dump_cmm, "";
"-dcse", Arg.Set dump_cse, "";
"-dsel", Arg.Set dump_selection, "";
- "-dlive", Arg.Unit(fun () -> dump_live := true;
- Printmach.print_live := true), "";
+ "-dlive", Arg.Unit(fun () -> dump_live := true ), "";
"-dspill", Arg.Set dump_spill, "";
"-dsplit", Arg.Set dump_split, "";
"-dinterf", Arg.Set dump_interf, "";
exit 0
module Options = Main_args.Make_bytetop_options (struct
- let set r () = r := true
- let clear r () = r := false
- open Clflags
- let _absname = set absname
- let _alert = Warnings.parse_alert_option
- let _I dir = include_dirs := dir :: !include_dirs
- let _init s = init_file := Some s
- let _noinit = set noinit
- let _labels = clear classic
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noprompt = set noprompt
- let _nopromptcont = set nopromptcont
- let _nostdlib = set no_std_include
- let _nopervasives = set nopervasives
- let _open s = open_modules := s :: !open_modules
- let _ppx _s = (* disabled *) ()
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _safe_string = clear unsafe_string
- let _short_paths = clear real_paths
+ include Main_args.Default.Topmain
let _stdin () = (* disabled *) ()
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _version () = (* disabled *) ()
- let _vnum () = (* disabled *) ()
- let _no_version = set noversion
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _dflambda = set dump_flambda
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
- let _dinstr = set dump_instr
- let _dcamlprimc = set keep_camlprimc_file
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
-
let _args = Arg.read_arg
let _args0 = Arg.read_arg0
-
let anonymous s = main s
end);;
"mulh", MULH;
"or", OR;
"proj", PROJ;
- "raise_withtrace", RAISE Cmm.Raise_withtrace;
- "raise_notrace", RAISE Cmm.Raise_notrace;
+ "raise", RAISE Lambda.Raise_regular;
+ "reraise", RAISE Lambda.Raise_reraise;
+ "raise_notrace", RAISE Lambda.Raise_notrace;
"seq", SEQ;
"signed", SIGNED;
"skip", SKIP;
%token OR
%token <int> POINTER
%token PROJ
-%token <Cmm.raise_kind> RAISE
+%token <Lambda.raise_kind> RAISE
%token RBRACKET
%token RPAREN
%token SEQ
{ Cifthenelse($3, debuginfo (), $4, debuginfo (), $5, debuginfo ()) }
| LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 }
| LPAREN WHILE expr sequence RPAREN
- { let body =
+ {
+ let lbl0 = Lambda.next_raise_count () in
+ let lbl1 = Lambda.next_raise_count () in
+ let body =
match $3 with
Cconst_int (x, _) when x <> 0 -> $4
- | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (), (Cexit(0,[])),
+ | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (),
+ (Cexit(lbl0,[])),
debuginfo ()) in
- Ccatch(Nonrecursive, [0, [],
+ Ccatch(Nonrecursive, [lbl0, [], Ctuple [], debuginfo ()],
Ccatch(Recursive,
- [1, [], Csequence(body, Cexit(1, [])), debuginfo ()],
- Cexit(1, [])), debuginfo ()], Ctuple []) }
+ [lbl1, [], Csequence(body, Cexit(lbl1, [])), debuginfo ()],
+ Cexit(lbl1, []))) }
| LPAREN EXIT IDENT exprlist RPAREN
{ Cexit(find_label $3, List.rev $4) }
| LPAREN CATCH sequence WITH catch_handlers RPAREN
| LPAREN TRY sequence WITH bind_ident sequence RPAREN
{ unbind_ident $5; Ctrywith($3, $5, $6, debuginfo ()) }
| LPAREN VAL expr expr RPAREN
- { Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],
+ { let open Asttypes in
+ Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],
debuginfo ()) }
| LPAREN ADDRAREF expr expr RPAREN
- { Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],
+ { let open Asttypes in
+ Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],
Debuginfo.none) }
| LPAREN INTAREF expr expr RPAREN
- { Cop(Cload (Word_int, Mutable), [access_array $3 $4 Arch.size_int],
+ { let open Asttypes in
+ Cop(Cload (Word_int, Mutable), [access_array $3 $4 Arch.size_int],
Debuginfo.none) }
| LPAREN FLOATAREF expr expr RPAREN
- { Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float],
+ { let open Asttypes in
+ Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float],
Debuginfo.none) }
| LPAREN ADDRASET expr expr expr RPAREN
- { Cop(Cstore (Word_val, Assignment),
+ { let open Lambda in
+ Cop(Cstore (Word_val, Assignment),
[access_array $3 $4 Arch.size_addr; $5], Debuginfo.none) }
| LPAREN INTASET expr expr expr RPAREN
- { Cop(Cstore (Word_int, Assignment),
+ { let open Lambda in
+ Cop(Cstore (Word_int, Assignment),
[access_array $3 $4 Arch.size_int; $5], Debuginfo.none) }
| LPAREN FLOATASET expr expr expr RPAREN
- { Cop(Cstore (Double_u, Assignment),
+ { let open Lambda in
+ Cop(Cstore (Double_u, Assignment),
[access_array $3 $4 Arch.size_float; $5], Debuginfo.none) }
;
exprlist:
| VAL { Word_val }
;
unaryop:
- LOAD chunk { Cload ($2, Mutable) }
+ LOAD chunk { Cload ($2, Asttypes.Mutable) }
| FLOATOFINT { Cfloatofint }
| INTOFFLOAT { Cintoffloat }
| RAISE { Craise $1 }
| ABSF { Cabsf }
;
binaryop:
- STORE chunk { Cstore ($2, Assignment) }
+ STORE chunk { Cstore ($2, Lambda.Assignment) }
| ADDI { Caddi }
| SUBI { Csubi }
| STAR { Cmuli }
+++ /dev/null
-tests/basic
-tests/basic-float
-tests/basic-io
-tests/basic-io-2
-tests/basic-manyargs
-tests/basic-modules
-tests/basic-more
-tests/basic-multdef
-tests/basic-private
-tests/typing-extension-constructor
-tests/typing-extensions
-tests/typing-fstclassmod
-tests/typing-gadts
-tests/typing-immediate
-tests/typing-implicit_unpack
-tests/typing-labels
-tests/typing-misc
-tests/typing-misc-bugs
-tests/typing-missing-cmi
-tests/typing-modules
-tests/typing-modules-bugs
-tests/typing-objects
-tests/typing-objects-bugs
-tests/typing-poly
-tests/typing-poly-bugs
-tests/typing-polyvariants-bugs
-tests/typing-polyvariants-bugs-2
-tests/typing-private
-tests/typing-private-bugs
-tests/typing-recmod
-tests/typing-recordarg
-tests/typing-rectypes-bugs
-tests/typing-safe-linking
-tests/typing-short-paths
-tests/typing-signatures
-tests/typing-sigsubst
-tests/typing-typeparam
-tests/typing-unboxed
-tests/typing-warnings
-tests/warnings
-addlabels.cmo : \
- ../parsing/parsetree.cmi \
- ../parsing/parse.cmi \
- ../parsing/longident.cmi \
- ../parsing/location.cmi \
- ../parsing/asttypes.cmi
-addlabels.cmx : \
- ../parsing/parsetree.cmi \
- ../parsing/parse.cmx \
- ../parsing/longident.cmx \
- ../parsing/location.cmx \
- ../parsing/asttypes.cmi
caml_tex.cmo : \
../toplevel/toploop.cmi \
../parsing/syntaxerr.cmi \
../typing/untypeast.cmi \
../typing/types.cmi \
../typing/typedtree.cmi \
- ../typing/tast_mapper.cmi \
+ ../typing/tast_iterator.cmi \
../typing/stypes.cmi \
../parsing/pprintast.cmi \
../typing/path.cmi \
../typing/untypeast.cmx \
../typing/types.cmx \
../typing/typedtree.cmx \
- ../typing/tast_mapper.cmx \
+ ../typing/tast_iterator.cmx \
../typing/stypes.cmx \
../parsing/pprintast.cmx \
../typing/path.cmx \
../file_formats/cmo_format.cmi \
../file_formats/cmi_format.cmx \
../bytecomp/bytesections.cmx
-ocaml299to3.cmo :
-ocaml299to3.cmx :
ocamlcp.cmo : \
../driver/main_args.cmi
ocamlcp.cmx : \
../file_formats/cmt_format.cmx \
cmt2annot.cmx \
../utils/clflags.cmx
-scrapelabels.cmo :
-scrapelabels.cmx :
stripdebug.cmo : \
../utils/misc.cmi \
../bytecomp/bytesections.cmi
middle_end/flambda/base_types driver toplevel \
file_formats lambda)
COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -strict-sequence -warn-error A \
- -safe-string -strict-formats -bin-annot $(INCLUDES)
+ -principal -safe-string -strict-formats -bin-annot $(INCLUDES)
LINKFLAGS = $(INCLUDES)
VPATH := $(filter-out -I,$(INCLUDES))
-# scrapelabels addlabels
-
.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
allopt: opt.opt
ocamlcp_cmos = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
- clflags.cmo main_args.cmo
+ clflags.cmo \
+ terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
+ main_args.cmo
$(call byte_and_opt,ocamlcp,$(ocamlcp_cmos) ocamlcp.cmo,)
OCAMLMKTOP=ocamlmktop.cmo
OCAMLMKTOP_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo \
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \
- load_path.cmo ccomp.cmo
+ load_path.cmo profile.cmo ccomp.cmo
$(call byte_and_opt,ocamlmktop,$(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP),)
# Converter olabl/ocaml 2.99 to ocaml 3
-OCAML299TO3=lexer299.cmo ocaml299to3.cmo
LIBRARY3=config.cmo build_path_prefix_map.cmo misc.cmo warnings.cmo location.cmo
-ocaml299to3: $(OCAML299TO3)
- $(CAMLC) $(LINKFLAGS) -o ocaml299to3 $(LIBRARY3) $(OCAML299TO3)
-
-lexer299.ml: lexer299.mll
- $(CAMLLEX) lexer299.mll
-
-#install::
-# $(INSTALL_PROG) ocaml299to3 "$(INSTALL_BINDIR)/ocaml299to3$(EXE)"
-
-clean::
- rm -f ocaml299to3 lexer299.ml
-
-# Label remover for interface files (upgrade 3.02 to 3.03)
-
-SCRAPELABELS= lexer301.cmo scrapelabels.cmo
-
-scrapelabels: $(SCRAPELABELS)
- $(CAMLC) $(LINKFLAGS) -o scrapelabels $(LIBRARY3) $(SCRAPELABELS)
-
-lexer301.ml: lexer301.mll
- $(CAMLLEX) lexer301.mll
-
-#install::
-# $(INSTALL_PROG) scrapelabels "$(INSTALL_LIBDIR)"
-
-clean::
- rm -f scrapelabels lexer301.ml
-
-# Insert labels following an interface file (upgrade 3.02 to 3.03)
-
-ADDLABELS_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo arg_helper.cmo \
- clflags.cmo identifiable.cmo numbers.cmo terminfo.cmo \
- warnings.cmo location.cmo longident.cmo docstrings.cmo \
- syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo
-
-addlabels: addlabels.cmo
- $(CAMLC) $(LINKFLAGS) -w sl -o addlabels \
- $(ADDLABELS_IMPORTS) addlabels.cmo
-
-#install::
-# $(INSTALL_PROG) addlabels "$(INSTALL_LIBDIR)"
-
ifeq ($(UNIX_OR_WIN32),unix)
LN := ln -sf
else
done
endif
-clean::
- rm -f addlabels
-
# The preprocessor for asm generators
CVT_EMIT=cvt_emit.cmo
clean::
if test -f cvt_emit; then mv -f cvt_emit cvt_emit.bak; else :; fi
-cvt_emit.ml: cvt_emit.mll
- $(CAMLLEX) cvt_emit.mll
-
clean::
rm -f cvt_emit.ml
$(call byte_and_opt,dumpobj,$(DUMPOBJ),)
-make_opcodes.ml: make_opcodes.mll
- $(CAMLLEX) make_opcodes.mll
-
make_opcodes: make_opcodes.ml
$(CAMLC) make_opcodes.ml -o $@
# Display info on compiled files
+DEF_SYMBOL_PREFIX = '-Dsymbol_prefix=""'
+
ifeq "$(SYSTEM)" "macosx"
DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"'
-else
-DEF_SYMBOL_PREFIX = '-Dsymbol_prefix=""'
+endif
+
+ifeq "$(SYSTEM)" "cygwin"
+DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"'
endif
objinfo_helper$(EXE): objinfo_helper.$(O)
# Common stuff
-.SUFFIXES:
+%.ml: %.mll
+ $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
%.cmo: %.ml
$(CAMLC) -c $(COMPFLAGS) - $<
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Jacques Garrigue, Kyoto University RIMS *)
-(* *)
-(* Copyright 2001 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* Copyright 2001 Kyoto University *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-open StdLabels
-open Asttypes
-open Parsetree
-
-let norec = ref false
-
-let input_file file =
- let ic = try open_in file with _ -> failwith ("input_file : " ^ file) in
- let b = Buffer.create 1024 in
- let buf = String.create 1024 and len = ref 0 in
- while len := input ic buf 0 1024; !len > 0 do
- Buffer.add_substring b buf 0 !len
- done;
- close_in ic;
- Buffer.contents b
-
-module SMap = struct
- include Map.Make(struct type t = string let compare = compare end)
- let rec removes l m =
- match l with [] -> m
- | k::l ->
- let m = try remove k m with Not_found -> m in
- removes l m
-end
-
-let rec labels_of_sty sty =
- match sty.ptyp_desc with
- Ptyp_arrow (lab, _, rem) -> lab :: labels_of_sty rem
- | Ptyp_alias (rem, _) -> labels_of_sty rem
- | _ -> []
-
-let rec labels_of_cty cty =
- match cty.pcty_desc with
- Pcty_arrow (lab, _, rem) ->
- let (labs, meths) = labels_of_cty rem in
- (lab :: labs, meths)
- | Pcty_signature { pcsig_fields = fields } ->
- ([],
- List.fold_left fields ~init:[] ~f:
- begin fun meths -> function
- { pctf_desc = Pctf_meth (s, _, sty) } -> (s, labels_of_sty sty)::meths
- | _ -> meths
- end)
- | _ ->
- ([],[])
-
-let rec pattern_vars pat =
- match pat.ppat_desc with
- Ppat_var s -> [s.txt]
- | Ppat_alias (pat, s) ->
- s.txt :: pattern_vars pat
- | Ppat_tuple l
- | Ppat_array l ->
- List.concat (List.map pattern_vars l)
- | Ppat_construct (_, Some pat)
- | Ppat_variant (_, Some pat)
- | Ppat_constraint (pat, _) ->
- pattern_vars pat
- | Ppat_record(l, _) ->
- List.concat (List.map l ~f:(fun (_,p) -> pattern_vars p))
- | Ppat_or (pat1, pat2) ->
- pattern_vars pat1 @ pattern_vars pat2
- | Ppat_lazy pat -> pattern_vars pat
- | Ppat_any | Ppat_constant _ | Ppat_construct _ | Ppat_variant _
- | Ppat_type _ | Ppat_unpack _ ->
- []
-
-let pattern_name pat =
- match pat.ppat_desc with
- Ppat_var s -> Some s
- | Ppat_constraint ({ppat_desc = Ppat_var s}, _) -> Some s
- | _ -> None
-
-let insertions = ref []
-let add_insertion pos s = insertions := (pos,s) :: !insertions
-let sort_insertions () =
- List.sort !insertions ~cmp:(fun (pos1,_) (pos2,_) -> pos1 - pos2)
-
-let is_space = function ' '|'\t'|'\n'|'\r' -> true | _ -> false
-let is_alphanum = function 'A'..'Z'|'a'..'z'|'_'|'\192'..'\214'|'\216'..'\246'
- | '\248'..'\255'|'\''|'0'..'9' -> true
- | _ -> false
-
-(* Remove "(" or "begin" before a pattern *)
-let rec insertion_point pos ~text =
- let pos' = ref (pos-1) in
- while is_space text.[!pos'] do decr pos' done;
- if text.[!pos'] = '(' then insertion_point !pos' ~text else
- if !pos' >= 5 && String.sub text ~pos:(!pos'-4) ~len:5 = "begin"
- && not (is_alphanum text.[!pos'-5]) then insertion_point (!pos'-4) ~text
- else pos
-
-(* Search "=" or "->" before "function" *)
-let rec insertion_point2 pos ~text =
- let pos' = ref (pos-1) in
- while is_space text.[!pos'] do decr pos' done;
- if text.[!pos'] = '(' then insertion_point2 !pos' ~text else
- if !pos' >= 5 && String.sub text ~pos:(!pos'-4) ~len:5 = "begin"
- && not (is_alphanum text.[!pos'-5]) then insertion_point2 (!pos'-4) ~text
- else if text.[!pos'] = '=' then Some !pos' else
- if !pos' >= 1 && text.[!pos'-1] = '-' && text.[!pos'] = '>'
- then Some (!pos' - 1)
- else None
-
-let rec insert_labels ~labels ~text expr =
- match labels, expr.pexp_desc with
- l::labels, Pexp_function(l', _, [pat, rem]) ->
- if l <> "" && l.[0] <> '?' && l' = "" then begin
- let start_c = pat.ppat_loc.Location.loc_start.Lexing.pos_cnum in
- let pos = insertion_point start_c ~text in
- match pattern_name pat with
- | Some name when l = name.txt -> add_insertion pos "~"
- | _ -> add_insertion pos ("~" ^ l ^ ":")
- end;
- insert_labels ~labels ~text rem
- | l::labels, Pexp_function(l', _, lst) ->
- let pos = expr.pexp_loc.Location.loc_start.Lexing.pos_cnum in
- if l <> "" && l.[0] <> '?' && l' = ""
- && String.sub text ~pos ~len:8 = "function" then begin
- String.blit ~src:"match th" ~src_pos:0 ~dst:text
- ~dst_pos:pos ~len:8;
- add_insertion (pos+6) (l ^ " wi");
- match insertion_point2 pos ~text with
- Some pos' ->
- add_insertion pos' ("~" ^ l ^ " ")
- | None ->
- add_insertion pos ("fun ~" ^ l ^ " -> ")
- end;
- List.iter lst ~f:(fun (p,e) -> insert_labels ~labels ~text e)
- | _, Pexp_match( _, lst) ->
- List.iter lst ~f:(fun (p,e) -> insert_labels ~labels ~text e)
- | _, Pexp_try(expr, lst) ->
- insert_labels ~labels ~text expr;
- List.iter lst ~f:(fun (p,e) -> insert_labels ~labels ~text e)
- | _, ( Pexp_let(_,_,e) | Pexp_sequence(_,e) | Pexp_when(_,e)
- | Pexp_constraint(e,_,_) | Pexp_letmodule(_,_,e)
- | Pexp_ifthenelse(_,e,None) ) ->
- insert_labels ~labels ~text e
- | _, Pexp_ifthenelse (_, e1, Some e2) ->
- insert_labels ~labels ~text e1;
- insert_labels ~labels ~text e2
- | _ ->
- ()
-
-let rec insert_labels_class ~labels ~text expr =
- match labels, expr.pcl_desc with
- l::labels, Pcl_fun(l', _, pat, rem) ->
- if l <> "" && l.[0] <> '?' && l' = "" then begin
- let start_c = pat.ppat_loc.Location.loc_start.Lexing.pos_cnum in
- let pos = insertion_point start_c ~text in
- match pattern_name pat with
- | Some name when l = name.txt -> add_insertion pos "~"
- | _ -> add_insertion pos ("~" ^ l ^ ":")
- end;
- insert_labels_class ~labels ~text rem
- | labels, (Pcl_constraint (expr, _) | Pcl_let (_, _, expr)) ->
- insert_labels_class ~labels ~text expr
- | _ ->
- ()
-
-let rec insert_labels_type ~labels ~text ty =
- match labels, ty.ptyp_desc with
- l::labels, Ptyp_arrow(l', _, rem) ->
- if l <> "" && l.[0] <> '?' && l' = "" then begin
- let start_c = ty.ptyp_loc.Location.loc_start.Lexing.pos_cnum in
- let pos = insertion_point start_c ~text in
- add_insertion pos (l ^ ":")
- end;
- insert_labels_type ~labels ~text rem
- | _ ->
- ()
-
-let rec insert_labels_app ~labels ~text args =
- match labels, args with
- l::labels, (l',arg)::args ->
- if l <> "" && l.[0] <> '?' && l' = "" then begin
- let pos0 = arg.pexp_loc.Location.loc_start.Lexing.pos_cnum in
- let pos = insertion_point pos0 ~text in
- match arg.pexp_desc with
- | Pexp_ident({ txt = Longident.Lident name })
- when l = name && pos = pos0 ->
- add_insertion pos "~"
- | _ -> add_insertion pos ("~" ^ l ^ ":")
- end;
- insert_labels_app ~labels ~text args
- | _ ->
- ()
-
-let insert_labels_app ~labels ~text args =
- let labels, opt_labels =
- List.partition labels ~f:(fun l -> l = "" || l.[0] <> '?') in
- let nopt_labels =
- List.map opt_labels
- ~f:(fun l -> String.sub l ~pos:1 ~len:(String.length l - 1)) in
- (* avoid ambiguous labels *)
- if List.exists labels ~f:(List.mem ~set:nopt_labels) then () else
- let aopt_labels = opt_labels @ nopt_labels in
- let args, lab_args = List.partition args ~f:(fun (l,_) -> l = "") in
- (* only optional arguments are labeled *)
- if List.for_all lab_args ~f:(fun (l,_) -> List.mem l ~set:aopt_labels)
- then insert_labels_app ~labels ~text args
-
-let rec add_labels_expr ~text ~values ~classes expr =
- let add_labels_rec ?(values=values) expr =
- add_labels_expr ~text ~values ~classes expr in
- match expr.pexp_desc with
- Pexp_apply ({pexp_desc=Pexp_ident({ txt = Longident.Lident s })}, args) ->
- begin try
- let labels = SMap.find s values in
- insert_labels_app ~labels ~text args
- with Not_found -> ()
- end;
- List.iter args ~f:(fun (_,e) -> add_labels_rec e)
- | Pexp_apply ({pexp_desc=Pexp_send
- ({pexp_desc=Pexp_ident({ txt = Longident.Lident s })},
- meth)},
- args) ->
- begin try
- if SMap.find s values = ["<object>"] then
- let labels = SMap.find (s ^ "#" ^ meth) values in
- insert_labels_app ~labels ~text args
- with Not_found -> ()
- end
- | Pexp_apply ({pexp_desc=Pexp_new ({ txt = Longident.Lident s })}, args) ->
- begin try
- let labels = SMap.find s classes in
- insert_labels_app ~labels ~text args
- with Not_found -> ()
- end
- | Pexp_let (recp, lst, expr) ->
- let vars = List.concat (List.map lst ~f:(fun (p,_) -> pattern_vars p)) in
- let vals = SMap.removes vars values in
- List.iter lst ~f:
- begin fun (_,e) ->
- add_labels_rec e ~values:(if recp = Recursive then vals else values)
- end;
- add_labels_rec expr ~values:vals
- | Pexp_function (_, None, lst) ->
- List.iter lst ~f:
- (fun (p,e) ->
- add_labels_rec e ~values:(SMap.removes (pattern_vars p) values))
- | Pexp_function (_, Some e, lst)
- | Pexp_match (e, lst)
- | Pexp_try (e, lst) ->
- add_labels_rec e;
- List.iter lst ~f:
- (fun (p,e) ->
- add_labels_rec e ~values:(SMap.removes (pattern_vars p) values))
- | Pexp_apply (e, args) ->
- List.iter add_labels_rec (e :: List.map snd args)
- | Pexp_tuple l | Pexp_array l ->
- List.iter add_labels_rec l
- | Pexp_construct (_, Some e)
- | Pexp_variant (_, Some e)
- | Pexp_field (e, _)
- | Pexp_constraint (e, _, _)
- | Pexp_send (e, _)
- | Pexp_setinstvar (_, e)
- | Pexp_letmodule (_, _, e)
- | Pexp_assert e
- | Pexp_lazy e
- | Pexp_poly (e, _)
- | Pexp_newtype (_, e)
- | Pexp_open (_, e) ->
- add_labels_rec e
- | Pexp_record (lst, opt) ->
- List.iter lst ~f:(fun (_,e) -> add_labels_rec e);
- begin match opt with Some e -> add_labels_rec e | None -> () end
- | Pexp_setfield (e1, _, e2)
- | Pexp_ifthenelse (e1, e2, None)
- | Pexp_sequence (e1, e2)
- | Pexp_while (e1, e2)
- | Pexp_when (e1, e2) ->
- add_labels_rec e1; add_labels_rec e2
- | Pexp_ifthenelse (e1, e2, Some e3) ->
- add_labels_rec e1; add_labels_rec e2; add_labels_rec e3
- | Pexp_for (s, e1, e2, _, e3) ->
- add_labels_rec e1; add_labels_rec e2;
- add_labels_rec e3 ~values:(SMap.removes [s.txt] values)
- | Pexp_override lst ->
- List.iter lst ~f:(fun (_,e) -> add_labels_rec e)
- | Pexp_ident _ | Pexp_constant _ | Pexp_construct _ | Pexp_variant _
- | Pexp_new _ | Pexp_object _ | Pexp_pack _ ->
- ()
-
-let rec add_labels_class ~text ~classes ~values ~methods cl =
- match cl.pcl_desc with
- Pcl_constr _ -> ()
- | Pcl_structure { pcstr_self = p; pcstr_fields = l } ->
- let values = SMap.removes (pattern_vars p) values in
- let values =
- match pattern_name p with None -> values
- | Some s ->
- List.fold_left methods
- ~init:(SMap.add s.txt ["<object>"] values)
- ~f:(fun m (k,l) -> SMap.add (s.txt^"#"^k) l m)
- in
- ignore (List.fold_left l ~init:values ~f:
- begin fun values -> function e -> match e.pcf_desc with
- | Pcf_val (s, _, _, e) ->
- add_labels_expr ~text ~classes ~values e;
- SMap.removes [s.txt] values
- | Pcf_meth (s, _, _, e) ->
- begin try
- let labels = List.assoc s.txt methods in
- insert_labels ~labels ~text e
- with Not_found -> ()
- end;
- add_labels_expr ~text ~classes ~values e;
- values
- | Pcf_init e ->
- add_labels_expr ~text ~classes ~values e;
- values
- | Pcf_inher _ | Pcf_valvirt _ | Pcf_virt _ | Pcf_constr _ -> values
- end)
- | Pcl_fun (_, opt, pat, cl) ->
- begin match opt with None -> ()
- | Some e -> add_labels_expr ~text ~classes ~values e
- end;
- let values = SMap.removes (pattern_vars pat) values in
- add_labels_class ~text ~classes ~values ~methods cl
- | Pcl_apply (cl, args) ->
- List.iter args ~f:(fun (_,e) -> add_labels_expr ~text ~classes ~values e);
- add_labels_class ~text ~classes ~values ~methods cl
- | Pcl_let (recp, lst, cl) ->
- let vars = List.concat (List.map lst ~f:(fun (p,_) -> pattern_vars p)) in
- let vals = SMap.removes vars values in
- List.iter lst ~f:
- begin fun (_,e) ->
- add_labels_expr e ~text ~classes
- ~values:(if recp = Recursive then vals else values)
- end;
- add_labels_class cl ~text ~classes ~values:vals ~methods
- | Pcl_constraint (cl, _) ->
- add_labels_class ~text ~classes ~values ~methods cl
-
-let add_labels ~intf ~impl ~file =
- insertions := [];
- let values, classes =
- List.fold_left intf ~init:(SMap.empty, SMap.empty) ~f:
- begin fun (values, classes as acc) item ->
- match item.psig_desc with
- Psig_value (name, {pval_type = sty}) ->
- (SMap.add name.txt (labels_of_sty sty) values, classes)
- | Psig_class l ->
- (values,
- List.fold_left l ~init:classes ~f:
- begin fun classes {pci_name=name; pci_expr=cty} ->
- SMap.add name.txt (labels_of_cty cty) classes
- end)
- | _ ->
- acc
- end
- in
- let text = input_file file in
- ignore (List.fold_right impl ~init:(values, classes) ~f:
- begin fun item (values, classes as acc) ->
- match item.pstr_desc with
- Pstr_value (recp, l) ->
- let names =
- List.concat (List.map l ~f:(fun (p,_) -> pattern_vars p)) in
- List.iter l ~f:
- begin fun (pat, expr) ->
- begin match pattern_name pat with
- | Some s ->
- begin try
- let labels = SMap.find s.txt values in
- insert_labels ~labels ~text expr;
- if !norec then () else
- let values =
- SMap.fold
- (fun s l m ->
- if List.mem s names then SMap.add s l m else m)
- values SMap.empty in
- add_labels_expr expr ~text ~values ~classes:SMap.empty
- with Not_found -> ()
- end
- | None -> ()
- end;
- end;
- (SMap.removes names values, classes)
- | Pstr_primitive (s, {pval_type=sty}) ->
- begin try
- let labels = SMap.find s.txt values in
- insert_labels_type ~labels ~text sty;
- (SMap.removes [s.txt] values, classes)
- with Not_found -> acc
- end
- | Pstr_class l ->
- let names = List.map l ~f:(fun pci -> pci.pci_name.txt) in
- List.iter l ~f:
- begin fun {pci_name=name; pci_expr=expr} ->
- try
- let (labels, methods) = SMap.find name.txt classes in
- insert_labels_class ~labels ~text expr;
- if !norec then () else
- let classes =
- SMap.fold
- (fun s (l,_) m ->
- if List.mem s names then SMap.add s l m else m)
- classes SMap.empty in
- add_labels_class expr ~text ~classes ~methods
- ~values:SMap.empty
- with Not_found -> ()
- end;
- (values, SMap.removes names classes)
- | _ ->
- acc
- end);
- if !insertions <> [] then begin
- let backup = file ^ ".bak" in
- if Sys.file_exists backup then Sys.remove file
- else Sys.rename file backup;
- let oc = open_out file in
- let last_pos =
- List.fold_left (sort_insertions ()) ~init:0 ~f:
- begin fun pos (pos', s) ->
- output oc text pos (pos'-pos);
- output_string oc s;
- pos'
- end in
- if last_pos < String.length text then
- output oc text last_pos (String.length text - last_pos);
- close_out oc
- end
- else prerr_endline ("No labels to insert in " ^ file)
-
-let process_file file =
- prerr_endline ("Processing " ^ file);
- if Filename.check_suffix file ".ml" then
- let intf = Filename.chop_suffix file ".ml" ^ ".mli" in
- let ic = open_in intf in
- let lexbuf = Lexing.from_channel ic in
- Location.init lexbuf intf;
- let intf = Parse.interface lexbuf in
- close_in ic;
- let ic = open_in file in
- let lexbuf = Lexing.from_channel ic in
- Location.init lexbuf file;
- let impl = Parse.implementation lexbuf in
- close_in ic;
- add_labels ~intf ~impl ~file
- else prerr_endline (file ^ " is not an implementation")
-
-let main () =
- let files = ref [] in
- Arg.parse ["-norec", Arg.Set norec, "do not labelize recursive calls"]
- (fun f -> files := f :: !files)
- "addlabels [-norec] <files>";
- let files = List.rev !files in
- List.iter files ~f:process_file
-
-let () = main ()
open StdLabels
open Str
-let camlbegin = "\\caml"
-let camlend = "\\endcaml"
-let camlin = {|\\?\1|}
-let camlout = {|\\:\1|}
-let camlbunderline = "\\<"
-let camleunderline = "\\>"
-
-let start newline out s args =
- Format.fprintf out "%s%s" camlbegin s;
+let camlprefix = "caml"
+
+let latex_escape s = String.concat "" ["$"; s; "$"]
+let camlin = latex_escape {|\\?|} ^ {|\1|}
+let camlout = latex_escape {|\\:|} ^ {|\1|}
+let camlbunderline = "<<"
+let camleunderline = ">>"
+
+
+(** Restrict the number of latex environment *)
+type env = Env of string
+let main = Env "example"
+let input_env = Env "input"
+let ok_output = Env "output"
+let error = Env "error"
+let warning = Env "warn"
+let phrase_env = Env ""
+
+let start out (Env s) args =
+ Format.fprintf out "\\begin{%s%s}" camlprefix s;
List.iter (Format.fprintf out "{%s}") args;
- if newline then Format.fprintf out "\n"
+ Format.fprintf out "\n"
-let stop newline out s =
- Format.fprintf out "%s%s" camlend s;
- if newline then Format.fprintf out "\n"
+let stop out (Env s) =
+ Format.fprintf out "\\end{%s%s}" camlprefix s;
+ Format.fprintf out "\n"
-let code_env ?(newline=true) env out s =
+let code_env env out s =
let sep = if s.[String.length s - 1] = '\n' then "" else "\n" in
Format.fprintf out "%a%s%s%a"
- (fun ppf env -> start false ppf env []) env s sep (stop newline) env
+ (fun ppf env -> start ppf env [])
+ env s sep stop env
+
-let main = "example"
type example_mode = Toplevel | Verbatim | Signature
let string_of_mode = function
| Toplevel -> "toplevel"
| Verbatim -> "verbatim"
| Signature -> "signature"
-let input_env = "input"
-let ok_output ="output"
-let error ="error"
-let warning ="warn"
-let phrase_env = ""
let verbose = ref true
let linelen = ref 72
let ellipsis start stop = { kind = Ellipsis; start; stop }
let escape_specials s =
- let s1 = global_replace ~!"\\\\" "\\\\\\\\" s in
- let s2 = global_replace ~!"'" "\\\\textquotesingle\\\\-" s1 in
- let s3 = global_replace ~!"`" "\\\\textasciigrave\\\\-" s2 in
- s3
+ s
+ |> global_replace ~!{|\$|} {|$\textdollar$|}
let rec apply_transform input (pos,underline_stop,out) t =
if pos >= String.length input then pos, underline_stop, out
else match underline_stop with
| Some stop when stop <= t.start ->
let f = escape_specials (String.sub input ~pos ~len:(stop - pos)) in
- let out = {|\>|} :: f :: out in
+ let out = camleunderline :: f :: out in
apply_transform input (stop,None,out) t
| _ ->
let out =
escape_specials (String.sub input ~pos ~len:(t.start - pos))::out in
match t.kind with
- | Ellipsis -> t.stop, underline_stop, {|\ldots|} :: out
+ | Ellipsis -> t.stop, underline_stop, latex_escape {|\ldots|} :: out
| Underline ->
- t.start, Some t.stop, {|\<|} :: out
+ t.start, Some t.stop, camlbunderline :: out
(** Check that all ellipsis are strictly nested inside underline transform
and that otherwise no transform starts before the end of the previous
| None -> last, ls
| Some stop ->
let f = escape_specials (String.sub s ~pos:last ~len:(stop - last)) in
- stop, {|\>|} :: f :: ls in
+ stop, camleunderline :: f :: ls in
let ls =
let n = String.length s in
if last = n then ls else
| Toplevel -> true in
let global_expected = try Output.expected @@ matched_group 4 !input
with Not_found -> Output.Ok in
- start true tex_fmt main [string_of_mode mode];
+ start tex_fmt main [string_of_mode mode];
let first = ref true in
let read_phrase () =
let phrase = Buffer.create 256 in
global_replace ~!{|^\(.\)|} camlout error_msgs
else if omit_answer then ""
else output in
- start false tex_fmt phrase_env [];
- code_env ~newline:omit_answer input_env tex_fmt phrase;
+ start tex_fmt phrase_env [];
+ code_env input_env tex_fmt phrase;
if String.length final_output > 0 then
- code_env ~newline:false (Output.env status) tex_fmt final_output;
- stop true tex_fmt phrase_env;
+ code_env (Output.env status) tex_fmt final_output;
+ stop tex_fmt phrase_env;
flush oc;
first := false;
if implicit_stop then raise End_of_file
done
- with End_of_file -> phrase_start:= !phrase_stop; stop true tex_fmt main
+ with End_of_file -> phrase_start:= !phrase_stop; stop tex_fmt main
end
else if string_match ~!"\\\\begin{caml_eval}[ \t]*$" !input 0
then begin
mtime() {
if test -z "$MTIME"
then echo 0
- else $MTIME $1
+ else $MTIME "$1"
fi
}
for %%P in (%CYGWIN_PACKAGES%) do call :CheckPackage %%P\r
call :UpgradeCygwin\r
\r
-"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh install" || exit /b 1\r
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh install" || exit /b 1\r
\r
goto :EOF\r
\r
call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"\r
)\r
rem Do the main build (either msvc64 or mingw32)\r
-"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh" || exit /b 1\r
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh" || exit /b 1\r
\r
if "%PORT%" neq "msvc64" goto :EOF\r
\r
rem Reconfigure the environment and run the msvc32 partial build\r
endlocal\r
call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x86\r
-"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh msvc32-only" || exit /b 1\r
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh msvc32-only" || exit /b 1\r
goto :EOF\r
\r
:test\r
rem Reconfigure the environment for the msvc64 build\r
call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"\r
-"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh test" || exit /b 1\r
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh test" || exit /b 1\r
goto :EOF\r
#* *
#**************************************************************************
+set -e
+
BUILD_PID=0
function run {
NAME=$1
shift
echo "-=-=- $NAME -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
- $@
+ "$@"
CODE=$?
- if [ $CODE -ne 0 ]; then
+ if [[ $CODE -ne 0 ]] ; then
echo "-=-=- $NAME failed! -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
- if [ $BUILD_PID -ne 0 ] ; then
+ if [[ $BUILD_PID -ne 0 ]] ; then
kill -KILL $BUILD_PID 2>/dev/null
wait $BUILD_PID 2>/dev/null
fi
FILE=$(pwd | cygpath -f - -m)/Makefile.config
echo "Edit $FILE to turn C compiler warnings into errors"
- sed -i -e "/^ *OC_CFLAGS *=/s/\r\?$/ $3\0/" $FILE
+ sed -i -e '/^ *OC_CFLAGS *=/s/\r\?$/ '"$3"'\0/' "$FILE"
# run "Content of $FILE" cat Makefile.config
}
-APPVEYOR_BUILD_FOLDER=$(echo $APPVEYOR_BUILD_FOLDER| cygpath -f -)
+APPVEYOR_BUILD_FOLDER=$(echo "$APPVEYOR_BUILD_FOLDER" | cygpath -f -)
# These directory names are specified here, because getting UTF-8 correctly
# through appveyor.yml -> Command Script -> Bash is quite painful...
-OCAMLROOT=$(echo $PROGRAMFILES/Бактріан🐫| cygpath -f - -m)
+OCAMLROOT=$(echo "$PROGRAMFILES/Бактріан🐫" | cygpath -f - -m)
# This must be kept in sync with appveyor_build.cmd
BUILD_PREFIX=🐫реализация
-export PATH=$(echo $OCAMLROOT| cygpath -f -)/bin/flexdll:$PATH
+PATH=$(echo "$OCAMLROOT" | cygpath -f -)/bin/flexdll:$PATH
case "$1" in
install)
mkdir -p "$OCAMLROOT/bin/flexdll"
- cd $APPVEYOR_BUILD_FOLDER/../flexdll
+ cd "$APPVEYOR_BUILD_FOLDER/../flexdll"
# msvc64 objects need to be compiled with VS2015, so are copied later from
# a source build.
for f in flexdll.h flexlink.exe flexdll*_msvc.obj default*.manifest ; do
- cp $f "$OCAMLROOT/bin/flexdll/"
+ cp "$f" "$OCAMLROOT/bin/flexdll/"
done
- if [ "$PORT" = "msvc64" ] ; then
+ if [[ $PORT = 'msvc64' ]] ; then
echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' \
>> ~/.bash_profile
fi
;;
msvc32-only)
- cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32
+ cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32"
set_configuration msvc "$OCAMLROOT-msvc32" -WX
- run "make world" make world
- run "make runtimeopt" make runtimeopt
- run "make -C otherlibs/systhreads libthreadsnat.lib" \
+ run 'make world' make world
+ run 'make runtimeopt' make runtimeopt
+ run 'make -C otherlibs/systhreads libthreadsnat.lib' \
make -C otherlibs/systhreads libthreadsnat.lib
exit 0
;;
test)
- FULL_BUILD_PREFIX=$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX
- run "ocamlc.opt -version" $FULL_BUILD_PREFIX-$PORT/ocamlc.opt -version
- run "test $PORT" make -C $FULL_BUILD_PREFIX-$PORT tests
- run "install $PORT" make -C $FULL_BUILD_PREFIX-$PORT install
- if [ "$PORT" = "msvc64" ] ; then
- run "check_all_arches" make -C $FULL_BUILD_PREFIX-$PORT check_all_arches
+ FULL_BUILD_PREFIX="$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX"
+ run 'ocamlc.opt -version' "$FULL_BUILD_PREFIX-$PORT/ocamlc.opt" -version
+ run "test $PORT" make -C "$FULL_BUILD_PREFIX-$PORT" tests
+ run "install $PORT" make -C "$FULL_BUILD_PREFIX-$PORT" install
+ if [[ $PORT = 'msvc64' ]] ; then
+ run 'check_all_arches' make -C "$FULL_BUILD_PREFIX-$PORT" check_all_arches
fi
;;
*)
- cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT
+ cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT"
- if [ "$PORT" = "msvc64" ] ; then
- tar -xzf $APPVEYOR_BUILD_FOLDER/flexdll.tar.gz
- cd flexdll-$FLEXDLL_VERSION
+ if [[ $PORT = 'msvc64' ]] ; then
+ tar -xzf "$APPVEYOR_BUILD_FOLDER/flexdll.tar.gz"
+ cd "flexdll-$FLEXDLL_VERSION"
make MSVC_DETECT=0 CHAINS=msvc64 support
cp flexdll*_msvc64.obj "$OCAMLROOT/bin/flexdll/"
cd ..
fi
- if [ "$PORT" = "msvc64" ] ; then
+ if [[ $PORT = 'msvc64' ]] ; then
set_configuration msvc64 "$OCAMLROOT" -WX
else
set_configuration mingw "$OCAMLROOT-mingw32" -Werror
fi
- cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT
+ cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT"
export TERM=ansi
- if [ "$PORT" = "mingw32" ] ; then
+ if [[ $PORT = 'mingw32' ]] ; then
set -o pipefail
# For an explanation of the sed command, see
# https://github.com/appveyor/ci/issues/1824
script --quiet --return --command \
"make -C ../$BUILD_PREFIX-mingw32 flexdll world.opt" \
- ../$BUILD_PREFIX-mingw32/build.log |
+ "../$BUILD_PREFIX-mingw32/build.log" |
sed -e 's/\d027\[K//g' \
-e 's/\d027\[m/\d027[0m/g' \
-e 's/\d027\[01\([m;]\)/\d027[1\1/g'
else
- run "make world" make world
- run "make bootstrap" make bootstrap
- run "make opt" make opt
- run "make opt.opt" make opt.opt
+ run 'make world' make world
+ run 'make bootstrap' make bootstrap
+ run 'make opt' make opt
+ run 'make opt.opt' make opt.opt
fi
;;
#########################################################################
-echo "======== clang 6.0, address sanitizer, UB sanitizer =========="
+# Ensure that the repo still passes the check-typo script
+if [ ! -x tools/check-typo ] ; then
+ error "tools/check-typo does not appear to be executable?"
+fi
+tools/check-typo
+
+#########################################################################
+
+echo "======== old school build =========="
+
+git clean -q -f -d -x
+
+instdir="$HOME/ocaml-tmp-install-$$"
+./configure --prefix "$instdir"
+
+# Build the system without using world.opt
+make $jobs world
+make $jobs opt
+make $jobs opt.opt
+make install
+
+rm -rf "$instdir"
-$make -s distclean || :
+# It's a build system test only, so we don't bother testing the compiler
-# `make distclean` does not clean the files from previous versions that
-# are not produced by the current version, so use `git clean` in addition.
-git clean -f -d -x
+#########################################################################
+
+echo "======== clang 6.0, address sanitizer, UB sanitizer =========="
+
+git clean -q -f -d -x
# Use clang 6.0
# We cannot give the sanitizer options as part of -cc because
make $jobs world.opt
# Run the testsuite.
-# The suppressed leak detections related to ocamlyacc mess up the output
-# of the tests and are reported as failures by ocamltest.
-# Hence, deactivate leak detection entirely.
+# We deactivate leak detection for two reasons:
+# - The suppressed leak detections related to ocamlyacc mess up the
+# output of the tests and are reported as failures by ocamltest.
+# - The Ocaml runtime does not free the memory when a fatal error
+# occurs.
-ASAN_OPTIONS="detect_leaks=0" $run_testsuite
+# We already use sigaltstack for stack overflow detection. Our use
+# interracts with ASAN's. Hence, we tell ASAN not to use it.
+
+ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite
#########################################################################
echo "======== clang 6.0, thread sanitizer =========="
-$make -s distclean || :
+git clean -q -f -d -x
./configure CC=clang-6.0
set_config_var OC_CFLAGS "-O1 \
-fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
-Wall -Werror \
--fsanitize=thread \
--fsanitize-blacklist=$(pwd)/tools/ci/inria/tsan-suppr.txt"
+-fsanitize=thread"
# Build the system
make $jobs world.opt
# echo "======== clang 6.0, memory sanitizer =========="
-# $make -s distclean || :
+# git clean -q -f -d -x
# # Use clang 6.0
# # We cannot give the sanitizer options as part of -cc because
# # Build the system (bytecode only) and test
# make $jobs world
# $run_testsuite
-
-#########################################################################
-
-# Ensure that the repo still passes the check-typo script
-if [ ! -x tools/check-typo ] ; then
- error "tools/check-typo does not appear to be executable?"
-fi
-tools/check-typo
# Tell gcc to use only ASCII in its diagnostic outputs.
export LC_ALL=C
-$make -s distclean || :
-
-# `make distclean` does not clean the files from previous versions that
-# are not produced by the current version, so use `git clean` in addition.
-git clean -f -d -x
+git clean -q -f -d -x
if $flambda; then
confoptions="$confoptions --enable-flambda --enable-flambda-invariants"
eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions
if $make_native; then
- $make $jobs world.opt
- if $check_make_alldepend; then $make alldepend; fi
+ $make $jobs --warn-undefined-variables
+ if $check_make_alldepend; then $make --warn-undefined-variables alldepend; fi
else
- $make $jobs world
+ $make $jobs --warn-undefined-variables
fi
if $dorebase; then
# temporary solution to the cygwin fork problem
rebase -b 0x7cd20000 otherlibs/unix/dllunix.so
rebase -b 0x7cdc0000 otherlibs/systhreads/dllthreads.so
fi
-$make install
+$make --warn-undefined-variables install
rm -rf "$instdir"
cd testsuite
if test -n "$jobs" && test -x /usr/bin/parallel
-then PARALLEL="$jobs $PARALLEL" $make parallel
-else $make all
+then PARALLEL="$jobs $PARALLEL" $make --warn-undefined-variables parallel
+else $make --warn-undefined-variables all
fi
+++ /dev/null
-# The treatment of pending signals involves unsynchronized accesses
-fun:caml_record_signal
-fun:caml_process_pending_signals
-fun:caml_leave_blocking_section
-# st_masterlock_waiters polls m->waiters without locking
-fun:st_masterlock_waiters
#* *
#**************************************************************************
+set -e
+
# TRAVIS_COMMIT_RANGE has the form <commit1>...<commit2>
# TRAVIS_CUR_HEAD is <commit1>
# TRAVIS_PR_HEAD is <commit2>
# | /
# TRAVIS_MERGE_BASE
#
-echo TRAVIS_COMMIT_RANGE=$TRAVIS_COMMIT_RANGE
-echo TRAVIS_COMMIT=$TRAVIS_COMMIT
-if [[ $TRAVIS_EVENT_TYPE = "pull_request" ]] ; then
+echo "TRAVIS_COMMIT_RANGE=$TRAVIS_COMMIT_RANGE"
+echo "TRAVIS_COMMIT=$TRAVIS_COMMIT"
+if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]] ; then
FETCH_HEAD=$(git rev-parse FETCH_HEAD)
- echo FETCH_HEAD=$FETCH_HEAD
+ echo "FETCH_HEAD=$FETCH_HEAD"
else
FETCH_HEAD=$TRAVIS_COMMIT
fi
-if [[ $TRAVIS_COMMIT != $(git rev-parse FETCH_HEAD) ]] ; then
- echo "WARNING! Travis TRAVIS_COMMIT and FETCH_HEAD do not agree!"
- if git cat-file -e $TRAVIS_COMMIT 2> /dev/null ; then
- echo "TRAVIS_COMMIT exists, so going with it"
- else
- echo "TRAVIS_COMMIT does not exist; setting to FETCH_HEAD"
- TRAVIS_COMMIT=$FETCH_HEAD
+if [[ $TRAVIS_EVENT_TYPE = 'push' ]] ; then
+ if ! git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then
+ echo 'TRAVIS_COMMIT does not exist - CI failure'
+ exit 1
+ fi
+else
+ if [[ $TRAVIS_COMMIT != $(git rev-parse FETCH_HEAD) ]] ; then
+ echo 'WARNING! Travis TRAVIS_COMMIT and FETCH_HEAD do not agree!'
+ if git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then
+ echo 'TRAVIS_COMMIT exists, so going with it'
+ else
+ echo 'TRAVIS_COMMIT does not exist; setting to FETCH_HEAD'
+ TRAVIS_COMMIT=$FETCH_HEAD
+ fi
fi
fi
# If this is not a pull request then TRAVIS_COMMIT_RANGE may be empty.
pull_request)
DEEPEN=50
- while ! git merge-base $TRAVIS_CUR_HEAD $TRAVIS_PR_HEAD > /dev/null 2>&1
+ while ! git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD" >& /dev/null
do
- echo Deepening $TRAVIS_BRANCH by $DEEPEN commits
- git fetch origin --deepen=$DEEPEN $TRAVIS_BRANCH
+ echo "Deepening $TRAVIS_BRANCH by $DEEPEN commits"
+ git fetch origin --deepen=$DEEPEN "$TRAVIS_BRANCH"
((DEEPEN*=2))
done
- TRAVIS_MERGE_BASE=$(git merge-base $TRAVIS_CUR_HEAD $TRAVIS_PR_HEAD);;
+ TRAVIS_MERGE_BASE=$(git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD");;
esac
BuildAndTest () {
------------------------------------------------------------------------
EOF
- configure_flags="\
- --prefix=$PREFIX \
- --enable-flambda-invariants \
- $CONFIG_ARG"
+ if [ "$MIN_BUILD" = "1" ] ; then
+ configure_flags="\
+ --prefix=$PREFIX \
+ --disable-shared \
+ --disable-debug-runtime \
+ --disable-instrumented-runtime \
+ --disable-systhreads \
+ --disable-str-lib \
+ --disable-unix-lib \
+ --disable-bigarray-lib \
+ --disable-ocamldoc \
+ --disable-native-compiler \
+ $CONFIG_ARG"
+ else
+ configure_flags="\
+ --prefix=$PREFIX \
+ --enable-flambda-invariants \
+ $CONFIG_ARG"
+ fi
case $XARCH in
x64)
./configure $configure_flags
;;
i386)
./configure --build=x86_64-pc-linux-gnu --host=i386-pc-linux-gnu \
- AS="as" ASPP="gcc -c" \
+ AS='as' ASPP='gcc -c' \
$configure_flags
;;
*)
esac
export PATH=$PREFIX/bin:$PATH
- $MAKE world.opt
- $MAKE ocamlnat
+ if [ "$MIN_BUILD" = "1" ] ; then
+ if $MAKE world.opt ; then
+ echo "world.opt is not supposed to work!"
+ exit 1
+ else
+ $MAKE world
+ fi
+ else
+ $MAKE world.opt
+ $MAKE ocamlnat
+ fi
cd testsuite
echo Running the testsuite with the normal runtime
$MAKE all
- echo Running the testsuite with the debug runtime
- $MAKE USE_RUNTIME="d" OCAMLTESTDIR=$(pwd)/_ocamltestd TESTLOG=_logd all
+ if [ "$MIN_BUILD" != "1" ] ; then
+ echo Running the testsuite with the debug runtime
+ $MAKE USE_RUNTIME='d' OCAMLTESTDIR="$(pwd)/_ocamltestd" TESTLOG=_logd all
+ fi
cd ..
+ if command -v pdflatex &>/dev/null ; then
+ echo Ensuring that all library documentation compiles
+ make -C ocamldoc html_doc pdf_doc texi_doc
+ fi
$MAKE install
- echo Check the code examples in the manual
- $MAKE manual-pregen
+ if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then
+ echo Check the code examples in the manual
+ $MAKE manual-pregen
+ fi
# check_all_arches checks tries to compile all backends in place,
# we would need to redo (small parts of) world.opt afterwards to
# use the compiler again
------------------------------------------------------------------------
EOF
# check that Changes has been modified
- git diff $TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD --name-only --exit-code Changes \
- > /dev/null && CheckNoChangesMessage || echo pass
+ git diff "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD" --name-only --exit-code \
+ Changes > /dev/null && CheckNoChangesMessage || echo pass
}
CheckNoChangesMessage () {
API_URL=https://api.github.com/repos/$TRAVIS_REPO_SLUG/issues/$TRAVIS_PULL_REQUEST/labels
- if test -n "$(git log --grep="[Nn]o [Cc]hange.* needed" --max-count=1 \
- ${TRAVIS_MERGE_BASE}..${TRAVIS_PR_HEAD})"
+ if [[ -n $(git log --grep='[Nn]o [Cc]hange.* needed' --max-count=1 \
+ "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD") ]]
then echo pass
- elif test -n "$(curl $API_URL | grep 'no-change-entry-needed')"
+ elif [[ -n $(curl "$API_URL" | grep 'no-change-entry-needed') ]]
then echo pass
else exit 1
fi
CheckManual () {
cat<<EOF
--------------------------------------------------------------------------
-This test checks that all standard library modules are referenced by the
-standard library chapter of the manual.
+This test checks the global structure of the reference manual
+(e.g. missing chapters).
--------------------------------------------------------------------------
EOF
# we need some of the configuration data provided by configure
./configure
- $MAKE check-stdlib -C manual/tests
+ $MAKE check-stdlib check-case-collision -C manual/tests
+
}
CheckTestsuiteModified () {
------------------------------------------------------------------------
EOF
# check that at least a file in testsuite/ has been modified
- git diff $TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD --name-only --exit-code \
+ git diff "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD" --name-only --exit-code \
testsuite > /dev/null && exit 1 || echo pass
}
# Test to see if any part of the directory name has been marked prune
not_pruned () {
DIR=$(dirname "$1")
- if [ "$DIR" = "." ] ; then
+ if [[ $DIR = '.' ]] ; then
return 0
else
case ",$(git check-attr typo.prune "$DIR" | sed -e 's/.*: //')," in
;;
*)
- not_pruned $DIR
+ not_pruned "$DIR"
return $?
esac
fi
CheckTypoTree () {
export OCAML_CT_HEAD=$1
export OCAML_CT_LS_FILES="git diff-tree --no-commit-id --name-only -r $2 --"
- export OCAML_CT_CAT="git cat-file --textconv"
+ export OCAML_CT_CAT='git cat-file --textconv'
export OCAML_CT_PREFIX="$1:"
- GIT_INDEX_FILE=tmp-index git read-tree --reset -i $1
- git diff-tree --diff-filter=d --no-commit-id --name-only -r $2 \
+ GIT_INDEX_FILE=tmp-index git read-tree --reset -i "$1"
+ git diff-tree --diff-filter=d --no-commit-id --name-only -r "$2" \
| (while IFS= read -r path
do
- if not_pruned $path ; then
+ if not_pruned "$path" ; then
echo "Checking $1: $path"
- if ! tools/check-typo ./$path ; then
+ if ! tools/check-typo "./$path" ; then
touch check-typo-failed
fi
else
esac
done)
rm -f tmp-index
- if [ -e CHECK_CONFIGURE ] ; then
+ if [[ -e CHECK_CONFIGURE ]] ; then
rm -f CHECK_CONFIGURE
echo "configure generation altered in $1"
- echo "Verifying that configure.ac generates configure"
+ echo 'Verifying that configure.ac generates configure'
git checkout "$1"
mv configure configure.ref
./autogen
CHECK_ALL_COMMITS=0
CheckTypo () {
- export OCAML_CT_GIT_INDEX="tmp-index"
- export OCAML_CT_CA_FLAG="--cached"
+ export OCAML_CT_GIT_INDEX='tmp-index'
+ export OCAML_CT_CA_FLAG='--cached'
# Work around an apparent bug in Ubuntu 12.4.5
# See https://bugs.launchpad.net/ubuntu/+source/gawk/+bug/1647879
rm -f check-typo-failed
- if test -z "$TRAVIS_COMMIT_RANGE"
- then CheckTypoTree $TRAVIS_COMMIT $TRAVIS_COMMIT
+ if [[ -z $TRAVIS_COMMIT_RANGE ]]
+ then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT"
else
- if [ "$TRAVIS_EVENT_TYPE" = "pull_request" ]
+ if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]]
then TRAVIS_COMMIT_RANGE=$TRAVIS_MERGE_BASE..$TRAVIS_PULL_REQUEST_SHA
fi
- if [ $CHECK_ALL_COMMITS -eq 1 ]
+ if [[ $CHECK_ALL_COMMITS -eq 1 ]]
then
- for commit in $(git rev-list $TRAVIS_COMMIT_RANGE --reverse)
+ for commit in $(git rev-list "$TRAVIS_COMMIT_RANGE" --reverse)
do
- CheckTypoTree $commit $commit
+ CheckTypoTree "$commit" "$commit"
done
else
- if [ -z "$TRAVIS_PULL_REQUEST_SHA" ]
- then CheckTypoTree $TRAVIS_COMMIT $TRAVIS_COMMIT
- else CheckTypoTree $TRAVIS_COMMIT $TRAVIS_COMMIT_RANGE
+ if [[ -z $TRAVIS_PULL_REQUEST_SHA ]]
+ then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT"
+ else CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT_RANGE"
fi
fi
fi
echo complete
- if [ -e check-typo-failed ]
+ if [[ -e check-typo-failed ]]
then exit 1
fi
}
open Asttypes
open Typedtree
-open Tast_mapper
+open Tast_iterator
-let bind_variables scope =
- let super = Tast_mapper.default in
+let variables_iterator scope =
+ let super = default_iterator in
let pat sub p =
begin match p.pat_desc with
| Tpat_var (id, _) | Tpat_alias (_, id, _) ->
{super with pat}
let bind_variables scope =
- let o = bind_variables scope in
- fun p -> ignore (o.pat o p)
+ let iter = variables_iterator scope in
+ fun p -> iter.pat iter p
let bind_bindings scope bindings =
let o = bind_variables scope in
| None -> c_rhs.exp_loc
| Some g -> {c_rhs.exp_loc with loc_start=g.exp_loc.loc_start}
in
- bind_variables loc c_lhs
+ bind_variables loc c_lhs
)
l
let record_module_binding scope mb =
Stypes.record (Stypes.An_ident
(mb.mb_name.loc,
- mb.mb_name.txt,
+ Option.value mb.mb_name.txt ~default:"_",
Annot.Idef scope))
let rec iterator ~scope rebuild_env =
- let super = Tast_mapper.default in
+ let super = default_iterator in
let class_expr sub node =
Stypes.record (Stypes.Ti_class node);
super.class_expr sub node
bind_cases f
| Texp_letmodule (_, modname, _, _, body ) ->
Stypes.record (Stypes.An_ident
- (modname.loc,modname.txt,Annot.Idef body.exp_loc))
+ (modname.loc,Option.value ~default:"_" modname.txt,
+ Annot.Idef body.exp_loc))
| _ -> ()
end;
Stypes.record (Stypes.Ti_expr exp);
this will give a slightly different scope for the non-recursive
binding case. *)
structure_item_rem sub s []
- and structure sub l =
+ in
+ let structure sub l =
let rec loop = function
- | str :: rem -> structure_item_rem sub str rem :: loop rem
- | [] -> []
+ | str :: rem -> structure_item_rem sub str rem; loop rem
+ | [] -> ()
in
- {l with str_items = loop l.str_items}
+ loop l.str_items
in
{super with class_expr; module_expr; expr; pat; structure_item; structure}
let binary_part iter x =
- let app f x = ignore (f iter x) in
let open Cmt_format in
match x with
- | Partial_structure x -> app iter.structure x
- | Partial_structure_item x -> app iter.structure_item x
- | Partial_expression x -> app iter.expr x
- | Partial_pattern x -> app iter.pat x
- | Partial_class_expr x -> app iter.class_expr x
- | Partial_signature x -> app iter.signature x
- | Partial_signature_item x -> app iter.signature_item x
- | Partial_module_type x -> app iter.module_type x
+ | Partial_structure x -> iter.structure iter x
+ | Partial_structure_item x -> iter.structure_item iter x
+ | Partial_expression x -> iter.expr iter x
+ | Partial_pattern x -> iter.pat iter x
+ | Partial_class_expr x -> iter.class_expr iter x
+ | Partial_signature x -> iter.signature iter x
+ | Partial_signature_item x -> iter.signature_item iter x
+ | Partial_module_type x -> iter.module_type iter x
(* Save cmt information as faked annotations, attached to
Location.none, on top of the .annot file. Only when -save-cmt-info is
| Some _ -> target_filename
in
if save_cmt_info then record_cmt_info cmt;
- let iterator = iterator ~scope:Location.none cmt.cmt_use_summaries in
+ let iter = iterator ~scope:Location.none cmt.cmt_use_summaries in
match cmt.cmt_annots with
| Implementation typedtree ->
- ignore (iterator.structure iterator typedtree);
+ iter.structure iter typedtree;
Stypes.dump target_filename
| Interface _ ->
Printf.eprintf "Cannot generate annotations for interface file\n%!";
exit 2
| Partial_implementation parts ->
- Array.iter (binary_part iterator) parts;
+ Array.iter (binary_part iter) parts;
Stypes.dump target_filename
| Packed _ ->
Printf.fprintf stderr "Packed files not yet supported\n%!";
end
define camlheap
- if $arg0 >= caml_young_start && $arg0 < caml_young_end
+ if $arg0 >= Caml_state->young_start && $arg0 < Caml_state->young_end
printf "YOUNG"
set $camlheap_result = 1
else
- set $chunk = caml_heap_start
+ set $chunk = Caml_state->heap_start
set $found = 0
while $chunk != 0 && ! $found
set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize)
# displays the list of heap chunks
define camlchunks
- set $chunk = * (unsigned long *) &caml_heap_start
+ set $chunk = * (unsigned long *) &Caml_state->heap_start
while $chunk != 0
set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize)
set $chunk_alloc = * (unsigned long *) ($chunk - 3 * $camlwordsize)
# `camlvisitfun` can set `$camlvisitstop` to stop the iteration
define camlvisit
- set $cvchunk = * (unsigned long *) &caml_heap_start
+ set $cvchunk = * (unsigned long *) &Caml_state->heap_start
set $camlvisitstop = 0
while $cvchunk != 0 && ! $camlvisitstop
set $cvchunk_size = * (unsigned long *) ($cvchunk - 2 * $camlwordsize)
end
define caml_cv_check_fl0
- if $hp == * (unsigned long *) &caml_heap_start
+ if $hp == * (unsigned long *) &Caml_state->heap_start
set $flcheck_prev = ((unsigned long) &sentinels + 16)
end
if $color == 2 && $size > 5
--- /dev/null
+#! /bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2019 MetaStack Solutions Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This script should have the same shebang as configure
+if test -e '.git' ; then :
+ if test -z "$ac_read_git_config" ; then :
+ extra_args=$(git config ocaml.configure 2>/dev/null)
+ extended_cache=$(git config ocaml.configure-cache 2>/dev/null)
+ cache_file=
+
+ # If ocaml.configure-cache is set, parse the command-line for the --host
+ # option, in order to determine the name of the cache file.
+ if test -n "$extended_cache" ; then :
+ echo "Detected Git configuration option ocaml.configure-cache set to \
+\"$extended_cache\""
+ dashdash=
+ prev=
+ host=default
+ # The logic here is pretty borrowed from autoconf's
+ for option in $extra_args "$@"
+ do
+ if test -n "$prev" ; then :
+ host=$option
+ continue
+ fi
+
+ case $dashdash$option in
+ --)
+ dashdash=yes ;;
+ -host | --host | --hos | --ho)
+ prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ case $option in
+ *=?*) host=$(expr "X$option" : '[^=]*=\(.*\)') ;;
+ *=) host= ;;
+ esac ;;
+ esac
+ done
+ cache_file="`dirname "$0"`/$extended_cache/ocaml-$host.cache"
+ fi
+
+ # If either option has a value, re-invoke configure
+ if test -n "$extra_args$cache_file" ; then :
+ echo "Detected Git configuration option ocaml.configure set to \
+\"$extra_args\""
+ # Too much effort to get the echo to show appropriate quoting - the
+ # invocation itself intentionally quotes $0 and passes $@ exactly as given
+ # but allows a single expansion of ocaml.configure
+ if test -n "$cache_file" ; then :
+ echo "Re-running $0 $extra_args --cache-file \"$cache_file\" $@"
+ ac_read_git_config=true exec "$0" $extra_args \
+ --cache-file "$cache_file" "$@"
+ else
+ echo "Re-running $0 $extra_args $@"
+ ac_read_git_config=true exec "$0" $extra_args "$@"
+ fi
+ fi
+ fi
+fi
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* The lexer definition *)
-
-{
-open Lexing
-open Misc
-
-type token =
- AMPERAMPER
- | AMPERSAND
- | AND
- | AS
- | ASSERT
- | BACKQUOTE
- | BAR
- | BARBAR
- | BARRBRACKET
- | BEGIN
- | CHAR of (char)
- | CLASS
- | COLON
- | COLONCOLON
- | COLONEQUAL
- | COLONGREATER
- | COMMA
- | CONSTRAINT
- | DO
- | DONE
- | DOT
- | DOTDOT
- | DOWNTO
- | ELSE
- | END
- | EOF
- | EQUAL
- | EXCEPTION
- | EXTERNAL
- | FALSE
- | FLOAT of (string)
- | FOR
- | FUN
- | FUNCTION
- | FUNCTOR
- | GREATER
- | GREATERRBRACE
- | GREATERRBRACKET
- | HASH
- | IF
- | IN
- | INCLUDE
- | INFIXOP0 of (string)
- | INFIXOP1 of (string)
- | INFIXOP2 of (string)
- | INFIXOP3 of (string)
- | INFIXOP4 of (string)
- | INHERIT
- | INITIALIZER
- | INT of (int)
- | LABEL of (string)
- | LABELID of (string)
- | LAZY
- | LBRACE
- | LBRACELESS
- | LBRACKET
- | LBRACKETBAR
- | LBRACKETLESS
- | LESS
- | LESSMINUS
- | LET
- | LIDENT of (string)
- | LPAREN
- | MATCH
- | METHOD
- | MINUSGREATER
- | MODULE
- | MUTABLE
- | NEW
- | OBJECT
- | OF
- | OPEN
- | OR
- | PARSER
- | PREFIXOP of (string)
- | PRIVATE
- | QUESTION
- | QUESTION2
- | QUOTE
- | RBRACE
- | RBRACKET
- | REC
- | RPAREN
- | SEMI
- | SEMISEMI
- | SIG
- | STAR
- | STRING of (string)
- | STRUCT
- | SUBTRACTIVE of (string)
- | THEN
- | TO
- | TRUE
- | TRY
- | TYPE
- | UIDENT of (string)
- | UNDERSCORE
- | VAL
- | VIRTUAL
- | WHEN
- | WHILE
- | WITH
-
-type error =
- | Illegal_character of char
- | Unterminated_comment
- | Unterminated_string
- | Unterminated_string_in_comment
-;;
-
-exception Error of error * int * int
-
-(* The table of keywords *)
-
-let keyword_table =
- create_hashtable 149 [
- "and", AND;
- "as", AS;
- "assert", ASSERT;
- "begin", BEGIN;
- "class", CLASS;
- "constraint", CONSTRAINT;
- "do", DO;
- "done", DONE;
- "downto", DOWNTO;
- "else", ELSE;
- "end", END;
- "exception", EXCEPTION;
- "external", EXTERNAL;
- "false", FALSE;
- "for", FOR;
- "fun", FUN;
- "function", FUNCTION;
- "functor", FUNCTOR;
- "if", IF;
- "in", IN;
- "include", INCLUDE;
- "inherit", INHERIT;
- "initializer", INITIALIZER;
- "lazy", LAZY;
- "let", LET;
- "match", MATCH;
- "method", METHOD;
- "module", MODULE;
- "mutable", MUTABLE;
- "new", NEW;
- "object", OBJECT;
- "of", OF;
- "open", OPEN;
- "or", OR;
- "parser", PARSER;
- "private", PRIVATE;
- "rec", REC;
- "sig", SIG;
- "struct", STRUCT;
- "then", THEN;
- "to", TO;
- "true", TRUE;
- "try", TRY;
- "type", TYPE;
- "val", VAL;
- "virtual", VIRTUAL;
- "when", WHEN;
- "while", WHILE;
- "with", WITH;
-
- "mod", INFIXOP3("mod");
- "land", INFIXOP3("land");
- "lor", INFIXOP3("lor");
- "lxor", INFIXOP3("lxor");
- "lsl", INFIXOP4("lsl");
- "lsr", INFIXOP4("lsr");
- "asr", INFIXOP4("asr")
-]
-
-(* To buffer string literals *)
-
-let initial_string_buffer = String.create 256
-let string_buff = ref initial_string_buffer
-let string_index = ref 0
-
-let reset_string_buffer () =
- string_buff := initial_string_buffer;
- string_index := 0
-
-let store_string_char c =
- if !string_index >= String.length (!string_buff) then begin
- let new_buff = String.create (String.length (!string_buff) * 2) in
- String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff));
- string_buff := new_buff
- end;
- String.unsafe_set (!string_buff) (!string_index) c;
- incr string_index
-
-let get_stored_string () =
- let s = String.sub (!string_buff) 0 (!string_index) in
- string_buff := initial_string_buffer;
- s
-
-(* To translate escape sequences *)
-
-let char_for_backslash = function
- | 'n' -> '\010'
- | 'r' -> '\013'
- | 'b' -> '\008'
- | 't' -> '\009'
- | c -> c
-
-let char_for_decimal_code lexbuf i =
- let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
- 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
- (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in
- Char.chr(c land 0xFF)
-
-(* To store the position of the beginning of a string and comment *)
-let string_start_pos = ref 0;;
-let comment_start_pos = ref [];;
-
-(* Error report *)
-
-open Format
-
-let report_error ppf = function
- | Illegal_character c ->
- fprintf ppf "Illegal character (%s)" (Char.escaped c)
- | Unterminated_comment ->
- fprintf ppf "Comment not terminated"
- | Unterminated_string ->
- fprintf ppf "String literal not terminated"
- | Unterminated_string_in_comment ->
- fprintf ppf "This comment contains an unterminated string literal"
-;;
-
-}
-
-let blank = [' ' '\010' '\013' '\009' '\012']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
- ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
-let symbolchar =
- ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
-let symbolchar2 =
- ['!' '$' '%' '&' '*' '+' '-' '.' '/' '<' '=' '>' '?' '@' '^' '|' '~']
-(* ['!' '$' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] *)
-let decimal_literal = ['0'-'9']+
-let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+
-let oct_literal = '0' ['o' 'O'] ['0'-'7']+
-let bin_literal = '0' ['b' 'B'] ['0'-'1']+
-let float_literal =
- ['0'-'9']+ ('.' ['0'-'9']* )? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
-
-rule token = parse
- blank +
- { token lexbuf }
- | "_"
- { UNDERSCORE }
- | lowercase identchar * ':' [ ^ ':' '=' '>']
- { let s = Lexing.lexeme lexbuf in
- lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - 1;
- lexbuf.lex_curr_p <-
- {lexbuf.lex_curr_p with pos_cnum = lexbuf.lex_curr_p.pos_cnum - 1};
- LABEL (String.sub s 0 (String.length s - 2)) }
-(*
- | lowercase identchar * ':'
- { let s = Lexing.lexeme lexbuf in
- LABEL (String.sub s 0 (String.length s - 1)) }
- | '%' lowercase identchar *
-*)
- | ':' lowercase identchar *
- { let s = Lexing.lexeme lexbuf in
- let l = String.length s - 1 in
- LABELID (String.sub s 1 l) }
- | lowercase identchar *
- { let s = Lexing.lexeme lexbuf in
- try
- Hashtbl.find keyword_table s
- with Not_found ->
- LIDENT s }
- | uppercase identchar *
- { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *)
- | decimal_literal | hex_literal | oct_literal | bin_literal
- { INT (int_of_string(Lexing.lexeme lexbuf)) }
- | float_literal
- { FLOAT (Lexing.lexeme lexbuf) }
- | "\""
- { reset_string_buffer();
- let string_start = Lexing.lexeme_start lexbuf in
- string_start_pos := string_start;
- string lexbuf;
- lexbuf.Lexing.lex_start_pos <-
- string_start - lexbuf.Lexing.lex_abs_pos;
- STRING (get_stored_string()) }
- | "'" [^ '\\' '\''] "'"
- { CHAR(Lexing.lexeme_char lexbuf 1) }
- | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
- { CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) }
- | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { CHAR(char_for_decimal_code lexbuf 2) }
- | "(*"
- { comment_start_pos := [Lexing.lexeme_start lexbuf];
- comment lexbuf;
- token lexbuf }
- | "(*)"
- { let loc = { Location.loc_start = Lexing.lexeme_start_p lexbuf;
- Location.loc_end = Lexing.lexeme_end_p lexbuf;
- Location.loc_ghost = false }
- in
- Location.prerr_warning loc (Warnings.Comment_start);
- comment_start_pos := [Lexing.lexeme_start lexbuf];
- comment lexbuf;
- token lexbuf
- }
- | "*)"
- { let loc = { Location.loc_start = Lexing.lexeme_start_p lexbuf;
- Location.loc_end = Lexing.lexeme_end_p lexbuf;
- Location.loc_ghost = false }
- in
- Location.prerr_warning loc Warnings.Comment_not_end;
- lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
- STAR
- }
- | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n")
- (* # linenum ... *)
- { token lexbuf }
- | "#" { HASH }
- | "&" { AMPERSAND }
- | "&&" { AMPERAMPER }
- | "`" { BACKQUOTE }
- | "'" { QUOTE }
- | "(" { LPAREN }
- | ")" { RPAREN }
- | "*" { STAR }
- | "," { COMMA }
- | "?" { QUESTION }
- | "??" { QUESTION2 }
- | "->" { MINUSGREATER }
- | "." { DOT }
- | ".." { DOTDOT }
- | ":" { COLON }
- | "::" { COLONCOLON }
- | ":=" { COLONEQUAL }
- | ":>" { COLONGREATER }
- | ";" { SEMI }
- | ";;" { SEMISEMI }
- | "<" { LESS }
- | "<-" { LESSMINUS }
- | "=" { EQUAL }
- | "[" { LBRACKET }
- | "[|" { LBRACKETBAR }
- | "[<" { LBRACKETLESS }
- | "]" { RBRACKET }
- | "{" { LBRACE }
- | "{<" { LBRACELESS }
- | "|" { BAR }
- | "||" { BARBAR }
- | "|]" { BARRBRACKET }
- | ">" { GREATER }
- | ">]" { GREATERRBRACKET }
- | "}" { RBRACE }
- | ">}" { GREATERRBRACE }
-
- | "!=" { INFIXOP0 "!=" }
- | "-" { SUBTRACTIVE "-" }
- | "-." { SUBTRACTIVE "-." }
-
- | ['!' '~'] symbolchar *
- { PREFIXOP(Lexing.lexeme lexbuf) }
- | '?' symbolchar2 *
- { PREFIXOP(Lexing.lexeme lexbuf) }
- | ['=' '<' '>' '|' '&' '$'] symbolchar *
- { INFIXOP0(Lexing.lexeme lexbuf) }
- | ['@' '^'] symbolchar *
- { INFIXOP1(Lexing.lexeme lexbuf) }
- | ['+' '-'] symbolchar *
- { INFIXOP2(Lexing.lexeme lexbuf) }
- | "**" symbolchar *
- { INFIXOP4(Lexing.lexeme lexbuf) }
- | ['*' '/' '%'] symbolchar *
- { INFIXOP3(Lexing.lexeme lexbuf) }
- | eof { EOF }
- | _
- { raise (Error(Illegal_character ((Lexing.lexeme lexbuf).[0]),
- Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) }
-
-and comment = parse
- "(*"
- { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
- comment lexbuf;
- }
- | "*)"
- { match !comment_start_pos with
- | [] -> assert false
- | [x] -> ()
- | _ :: l -> comment_start_pos := l;
- comment lexbuf;
- }
- | "\""
- { reset_string_buffer();
- string_start_pos := Lexing.lexeme_start lexbuf;
- begin try string lexbuf
- with Error (Unterminated_string, _, _) ->
- let st = List.hd !comment_start_pos in
- raise (Error (Unterminated_string_in_comment, st, st + 2))
- end;
- string_buff := initial_string_buffer;
- comment lexbuf }
- | "''"
- { comment lexbuf }
- | "'" [^ '\\' '\''] "'"
- { comment lexbuf }
- | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'"
- { comment lexbuf }
- | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { comment lexbuf }
- | eof
- { let st = List.hd !comment_start_pos in
- raise (Error (Unterminated_comment, st, st + 2));
- }
- | _
- { comment lexbuf }
-
-and string = parse
- '"'
- { () }
- | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] *
- { string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
- { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
- string lexbuf }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
- { store_string_char(char_for_decimal_code lexbuf 1);
- string lexbuf }
- | eof
- { raise (Error (Unterminated_string,
- !string_start_pos, !string_start_pos+1)) }
- | _
- { store_string_char(Lexing.lexeme_char lexbuf 0);
- string lexbuf }
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* The lexer definition *)
-
-{
-open Misc
-
-type token =
- AMPERAMPER
- | AMPERSAND
- | AND
- | AS
- | ASSERT
- | BACKQUOTE
- | BAR
- | BARBAR
- | BARRBRACKET
- | BEGIN
- | CHAR of (char)
- | CLASS
- | COLON
- | COLONCOLON
- | COLONEQUAL
- | COLONGREATER
- | COMMA
- | CONSTRAINT
- | DO
- | DONE
- | DOT
- | DOTDOT
- | DOWNTO
- | ELSE
- | END
- | EOF
- | EQUAL
- | EXCEPTION
- | EXTERNAL
- | FALSE
- | FLOAT of (string)
- | FOR
- | FUN
- | FUNCTION
- | FUNCTOR
- | GREATER
- | GREATERRBRACE
- | GREATERRBRACKET
- | HASH
- | IF
- | IN
- | INCLUDE
- | INFIXOP0 of (string)
- | INFIXOP1 of (string)
- | INFIXOP2 of (string)
- | INFIXOP3 of (string)
- | INFIXOP4 of (string)
- | INHERIT
- | INITIALIZER
- | INT of (int)
- | LABEL of (string)
- | LAZY
- | LBRACE
- | LBRACELESS
- | LBRACKET
- | LBRACKETBAR
- | LBRACKETLESS
- | LESS
- | LESSMINUS
- | LET
- | LIDENT of (string)
- | LPAREN
- | MATCH
- | METHOD
- | MINUS
- | MINUSDOT
- | MINUSGREATER
- | MODULE
- | MUTABLE
- | NEW
- | OBJECT
- | OF
- | OPEN
- | OPTLABEL of (string)
- | OR
- | PARSER
- | PLUS
- | PREFIXOP of (string)
- | PRIVATE
- | QUESTION
- | QUESTION2
- | QUOTE
- | RBRACE
- | RBRACKET
- | REC
- | RPAREN
- | SEMI
- | SEMISEMI
- | SIG
- | STAR
- | STRING of (string)
- | STRUCT
- | THEN
- | TILDE
- | TO
- | TRUE
- | TRY
- | TYPE
- | UIDENT of (string)
- | UNDERSCORE
- | VAL
- | VIRTUAL
- | WHEN
- | WHILE
- | WITH
-
-type error =
- | Illegal_character of char
- | Unterminated_comment
- | Unterminated_string
- | Unterminated_string_in_comment
- | Keyword_as_label of string
-;;
-
-exception Error of error * int * int
-
-(* The table of keywords *)
-
-let keyword_table =
- create_hashtable 149 [
- "and", AND;
- "as", AS;
- "assert", ASSERT;
- "begin", BEGIN;
- "class", CLASS;
- "constraint", CONSTRAINT;
- "do", DO;
- "done", DONE;
- "downto", DOWNTO;
- "else", ELSE;
- "end", END;
- "exception", EXCEPTION;
- "external", EXTERNAL;
- "false", FALSE;
- "for", FOR;
- "fun", FUN;
- "function", FUNCTION;
- "functor", FUNCTOR;
- "if", IF;
- "in", IN;
- "include", INCLUDE;
- "inherit", INHERIT;
- "initializer", INITIALIZER;
- "lazy", LAZY;
- "let", LET;
- "match", MATCH;
- "method", METHOD;
- "module", MODULE;
- "mutable", MUTABLE;
- "new", NEW;
- "object", OBJECT;
- "of", OF;
- "open", OPEN;
- "or", OR;
- "parser", PARSER;
- "private", PRIVATE;
- "rec", REC;
- "sig", SIG;
- "struct", STRUCT;
- "then", THEN;
- "to", TO;
- "true", TRUE;
- "try", TRY;
- "type", TYPE;
- "val", VAL;
- "virtual", VIRTUAL;
- "when", WHEN;
- "while", WHILE;
- "with", WITH;
-
- "mod", INFIXOP3("mod");
- "land", INFIXOP3("land");
- "lor", INFIXOP3("lor");
- "lxor", INFIXOP3("lxor");
- "lsl", INFIXOP4("lsl");
- "lsr", INFIXOP4("lsr");
- "asr", INFIXOP4("asr")
-]
-
-(* To buffer string literals *)
-
-let initial_string_buffer = String.create 256
-let string_buff = ref initial_string_buffer
-let string_index = ref 0
-
-let reset_string_buffer () =
- string_buff := initial_string_buffer;
- string_index := 0
-
-let store_string_char c =
- if !string_index >= String.length (!string_buff) then begin
- let new_buff = String.create (String.length (!string_buff) * 2) in
- String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff));
- string_buff := new_buff
- end;
- String.unsafe_set (!string_buff) (!string_index) c;
- incr string_index
-
-let get_stored_string () =
- let s = String.sub (!string_buff) 0 (!string_index) in
- string_buff := initial_string_buffer;
- s
-
-(* To translate escape sequences *)
-
-let char_for_backslash = function
- | 'n' -> '\010'
- | 'r' -> '\013'
- | 'b' -> '\008'
- | 't' -> '\009'
- | c -> c
-
-let char_for_decimal_code lexbuf i =
- let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
- 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
- (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in
- Char.chr(c land 0xFF)
-
-(* To store the position of the beginning of a string and comment *)
-let string_start_pos = ref 0;;
-let comment_start_pos = ref [];;
-let in_comment () = !comment_start_pos <> [];;
-
-(* Error report *)
-
-open Format
-
-let report_error ppf = function
- | Illegal_character c ->
- fprintf ppf "Illegal character (%s)" (Char.escaped c)
- | Unterminated_comment ->
- fprintf ppf "Comment not terminated"
- | Unterminated_string ->
- fprintf ppf "String literal not terminated"
- | Unterminated_string_in_comment ->
- fprintf ppf "This comment contains an unterminated string literal"
- | Keyword_as_label kwd ->
- fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd
-;;
-
-}
-
-let blank = [' ' '\010' '\013' '\009' '\012']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
- ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
-let symbolchar =
- ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
-let decimal_literal = ['0'-'9']+
-let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+
-let oct_literal = '0' ['o' 'O'] ['0'-'7']+
-let bin_literal = '0' ['b' 'B'] ['0'-'1']+
-let float_literal =
- ['0'-'9']+ ('.' ['0'-'9']* )? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
-
-rule token = parse
- blank +
- { token lexbuf }
- | "_"
- { UNDERSCORE }
- | "~" { TILDE }
- | "~" lowercase identchar * ':'
- { let s = Lexing.lexeme lexbuf in
- let name = String.sub s 1 (String.length s - 2) in
- if Hashtbl.mem keyword_table name then
- raise (Error(Keyword_as_label name, Lexing.lexeme_start lexbuf,
- Lexing.lexeme_end lexbuf));
- LABEL name }
- | "?" { QUESTION }
- | "?" lowercase identchar * ':'
- { let s = Lexing.lexeme lexbuf in
- let name = String.sub s 1 (String.length s - 2) in
- if Hashtbl.mem keyword_table name then
- raise (Error(Keyword_as_label name, Lexing.lexeme_start lexbuf,
- Lexing.lexeme_end lexbuf));
- OPTLABEL name }
- | lowercase identchar *
- { let s = Lexing.lexeme lexbuf in
- try
- Hashtbl.find keyword_table s
- with Not_found ->
- LIDENT s }
- | uppercase identchar *
- { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *)
- | decimal_literal | hex_literal | oct_literal | bin_literal
- { INT (int_of_string(Lexing.lexeme lexbuf)) }
- | float_literal
- { FLOAT (Lexing.lexeme lexbuf) }
- | "\""
- { reset_string_buffer();
- let string_start = Lexing.lexeme_start lexbuf in
- string_start_pos := string_start;
- string lexbuf;
- lexbuf.Lexing.lex_start_pos <-
- string_start - lexbuf.Lexing.lex_abs_pos;
- STRING (get_stored_string()) }
- | "'" [^ '\\' '\''] "'"
- { CHAR(Lexing.lexeme_char lexbuf 1) }
- | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
- { CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) }
- | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { CHAR(char_for_decimal_code lexbuf 2) }
- | "(*"
- { comment_start_pos := [Lexing.lexeme_start lexbuf];
- comment lexbuf;
- token lexbuf }
- | "(*)"
- { let loc = Location.curr lexbuf
- and warn = Warnings.Comment_start
- in
- Location.prerr_warning loc warn;
- comment_start_pos := [Lexing.lexeme_start lexbuf];
- comment lexbuf;
- token lexbuf
- }
- | "*)"
- { let loc = Location.curr lexbuf
- and warn = Warnings.Comment_not_end
- in
- Location.prerr_warning loc warn;
- lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
- STAR
- }
- | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n")
- (* # linenum ... *)
- { token lexbuf }
- | "#" { HASH }
- | "&" { AMPERSAND }
- | "&&" { AMPERAMPER }
- | "`" { BACKQUOTE }
- | "'" { QUOTE }
- | "(" { LPAREN }
- | ")" { RPAREN }
- | "*" { STAR }
- | "," { COMMA }
- | "??" { QUESTION2 }
- | "->" { MINUSGREATER }
- | "." { DOT }
- | ".." { DOTDOT }
- | ":" { COLON }
- | "::" { COLONCOLON }
- | ":=" { COLONEQUAL }
- | ":>" { COLONGREATER }
- | ";" { SEMI }
- | ";;" { SEMISEMI }
- | "<" { LESS }
- | "<-" { LESSMINUS }
- | "=" { EQUAL }
- | "[" { LBRACKET }
- | "[|" { LBRACKETBAR }
- | "[<" { LBRACKETLESS }
- | "]" { RBRACKET }
- | "{" { LBRACE }
- | "{<" { LBRACELESS }
- | "|" { BAR }
- | "||" { BARBAR }
- | "|]" { BARRBRACKET }
- | ">" { GREATER }
- | ">]" { GREATERRBRACKET }
- | "}" { RBRACE }
- | ">}" { GREATERRBRACE }
-
- | "!=" { INFIXOP0 "!=" }
- | "+" { PLUS }
- | "-" { MINUS }
- | "-." { MINUSDOT }
-
- | "!" symbolchar *
- { PREFIXOP(Lexing.lexeme lexbuf) }
- | ['~' '?'] symbolchar +
- { PREFIXOP(Lexing.lexeme lexbuf) }
- | ['=' '<' '>' '|' '&' '$'] symbolchar *
- { INFIXOP0(Lexing.lexeme lexbuf) }
- | ['@' '^'] symbolchar *
- { INFIXOP1(Lexing.lexeme lexbuf) }
- | ['+' '-'] symbolchar *
- { INFIXOP2(Lexing.lexeme lexbuf) }
- | "**" symbolchar *
- { INFIXOP4(Lexing.lexeme lexbuf) }
- | ['*' '/' '%'] symbolchar *
- { INFIXOP3(Lexing.lexeme lexbuf) }
- | eof { EOF }
- | _
- { raise (Error(Illegal_character ((Lexing.lexeme lexbuf).[0]),
- Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) }
-
-and comment = parse
- "(*"
- { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
- comment lexbuf;
- }
- | "*)"
- { match !comment_start_pos with
- | [] -> assert false
- | [x] -> comment_start_pos := [];
- | _ :: l -> comment_start_pos := l;
- comment lexbuf;
- }
- | "\""
- { reset_string_buffer();
- string_start_pos := Lexing.lexeme_start lexbuf;
- begin try string lexbuf
- with Error (Unterminated_string, _, _) ->
- let st = List.hd !comment_start_pos in
- raise (Error (Unterminated_string_in_comment, st, st + 2))
- end;
- string_buff := initial_string_buffer;
- comment lexbuf }
- | "''"
- { comment lexbuf }
- | "'" [^ '\\' '\''] "'"
- { comment lexbuf }
- | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'"
- { comment lexbuf }
- | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { comment lexbuf }
- | eof
- { let st = List.hd !comment_start_pos in
- raise (Error (Unterminated_comment, st, st + 2));
- }
- | _
- { comment lexbuf }
-
-and string = parse
- '"'
- { () }
- | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] *
- { string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
- { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
- string lexbuf }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
- { store_string_char(char_for_decimal_code lexbuf 1);
- string lexbuf }
- | eof
- { raise (Error (Unterminated_string,
- !string_start_pos, !string_start_pos+1)) }
- | _
- { store_string_char(Lexing.lexeme_char lexbuf 0);
- string lexbuf }
case $# in
0) version="`ocamlc -v | tr -d '\r' | sed -n -e 's/.*version //p'`";;
- 1) version="`sed -e 1q $1 | tr -d '\r'`";;
+ 1) version="`sed -e 1q "$1" | tr -d '\r'`";;
*) echo "usage: make-version-header.sh [version-file]" >&2
exit 2;;
esac
suffix="`echo "$version" | sed -n -e '1s/^[^+]*+\(.*\)/\1/p'`"
echo "#define OCAML_VERSION_MAJOR $major"
-printf "#define OCAML_VERSION_MINOR %d\n" $minor
+printf '#define OCAML_VERSION_MINOR %d\n' "$minor"
case $patchlvl in "") patchlvl=0;; esac
echo "#define OCAML_VERSION_PATCHLEVEL $patchlvl"
case "$suffix" in
"") echo "#undef OCAML_VERSION_ADDITIONAL";;
*) echo "#define OCAML_VERSION_ADDITIONAL \"$suffix\"";;
esac
-printf "#define OCAML_VERSION %d%02d%02d\n" $major $minor $patchlvl
+printf '#define OCAML_VERSION %d%02d%02d\n' "$major" "$minor" "$patchlvl"
echo "#define OCAML_VERSION_STRING \"$version\""
#ifdef HAS_LIBBFD
#include <stdlib.h>
#include <string.h>
+#include <stdarg.h>
// PACKAGE: protect against binutils change
// https://sourceware.org/bugzilla/show_bug.cgi?id=14243
#define plugin_header_sym (symbol_prefix "caml_plugin_header")
-int main(int argc, char ** argv)
+/* We need to refer to a few functions of the BFD library that are */
+/* actually defined as macros. We thus define equivalent */
+/* functions below */
+
+long get_static_symtab_upper_bound(bfd *fd)
+{
+ return bfd_get_symtab_upper_bound(fd);
+}
+
+long get_dynamic_symtab_upper_bound(bfd *fd)
+{
+ return bfd_get_dynamic_symtab_upper_bound(fd);
+}
+
+long canonicalize_static_symtab(bfd * fd, asymbol **symbolTable)
+{
+ return bfd_canonicalize_symtab(fd, symbolTable);
+}
+
+long canonicalize_dynamic_symtab(bfd * fd, asymbol **symbolTable)
+{
+ return bfd_canonicalize_dynamic_symtab(fd, symbolTable);
+}
+
+typedef struct {
+ long (*get_upper_bound)(bfd *);
+ long (*canonicalize)(bfd *, asymbol **);
+} symTable_ops;
+
+symTable_ops staticSymTable_ops = {
+ &get_static_symtab_upper_bound,
+ &canonicalize_static_symtab
+};
+
+symTable_ops dynamicSymTable_ops = {
+ &get_dynamic_symtab_upper_bound,
+ &canonicalize_dynamic_symtab
+};
+
+/* Print an error message and exit */
+static void error(bfd *fd, char *msg, ...)
+{
+ va_list ap;
+ va_start(ap, msg);
+ vfprintf (stderr, msg, ap);
+ va_end(ap);
+ fprintf(stderr, "\n");
+ if (fd!=NULL) bfd_close(fd);
+ exit(2);
+}
+
+/* Look for plugin_header_sym in the specified symbol table */
+/* Return its address, -1 if not found */
+long lookup(bfd* fd, symTable_ops *ops)
{
- bfd *fd;
- asection *sec;
- file_ptr offset;
long st_size;
asymbol ** symbol_table;
long sym_count, i;
- if (argc != 2) {
- fprintf(stderr, "Usage: objinfo_helper <dynamic library>\n");
- return 2;
+ st_size = ops->get_upper_bound (fd);
+ if (st_size <= 0) return -1;
+
+ symbol_table = malloc(st_size);
+ if (! symbol_table)
+ error(fd, "Error: out of memory");
+
+ sym_count = ops->canonicalize (fd, symbol_table);
+
+ for (i = 0; i < sym_count; i++) {
+ if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0)
+ return symbol_table[i]->value;
}
+ return -1;
+}
+
+int main(int argc, char ** argv)
+{
+ bfd *fd;
+ asection *sec;
+ file_ptr offset;
+ long value;
+
+ if (argc != 2)
+ error(NULL, "Usage: objinfo_helper <dynamic library>");
fd = bfd_openr(argv[1], "default");
- if (!fd) {
- fprintf(stderr, "Error opening file %s\n", argv[1]);
- return 2;
- }
- if (! bfd_check_format (fd, bfd_object)) {
- fprintf(stderr, "Error: wrong format\n");
- bfd_close(fd);
- return 2;
- }
+ if (!fd)
+ error(NULL, "Error opening file %s", argv[1]);
+ if (! bfd_check_format (fd, bfd_object))
+ error(fd, "Error: wrong format");
sec = bfd_get_section_by_name(fd, ".data");
- if (! sec) {
- fprintf(stderr, "Error: section .data not found\n");
- bfd_close(fd);
- return 2;
- }
+ if (! sec)
+ error(fd, "Error: section .data not found");
offset = sec->filepos;
- st_size = bfd_get_dynamic_symtab_upper_bound (fd);
- if (st_size <= 0) {
- fprintf(stderr, "Error: size of section .data unknown\n");
- bfd_close(fd);
- return 2;
- }
- symbol_table = malloc(st_size);
- if (! symbol_table) {
- fprintf(stderr, "Error: out of memory\n");
- bfd_close(fd);
- return 2;
- }
+ value = lookup(fd, &dynamicSymTable_ops);
- sym_count = bfd_canonicalize_dynamic_symtab (fd, symbol_table);
+ if (value == -1)
+ value = lookup(fd, &staticSymTable_ops);
+ bfd_close(fd);
- for (i = 0; i < sym_count; i++) {
- if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0) {
- printf("%ld\n", (long) (offset + symbol_table[i]->value));
- bfd_close(fd);
- return 0;
- }
- }
+ if (value == -1)
+ error(NULL, "Error: missing symbol %s", plugin_header_sym);
- fprintf(stderr, "Error: missing symbol %s\n", plugin_header_sym);
- bfd_close(fd);
- return 2;
+ printf("%ld\n", (long) offset + value);
}
#else
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Jacques Garrigue, Kyoto University RIMS *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-open Lexer299
-
-let input_buffer = Buffer.create 16383
-let input_function ic buf len =
- let len = input ic buf 0 len in
- Buffer.add_substring input_buffer buf 0 len;
- len
-
-let output_buffer = Buffer.create 16383
-
-let modified = ref false
-
-let convert buffer =
- let input_pos = ref 0 in
- let copy_input stop =
- Buffer.add_substring output_buffer (Buffer.contents input_buffer)
- !input_pos (stop - !input_pos);
- input_pos := stop
- in
- let last = ref (EOF, 0, 0) in
- try while true do
- let token = Lexer299.token buffer
- and start = Lexing.lexeme_start buffer
- and stop = Lexing.lexeme_end buffer
- and last_token, last_start, last_stop = !last in
- begin match token with
- | LABEL l0 ->
- let l = if l0 = "fun" then "f" else l0 in
- begin match last_token with
- | PREFIXOP "?(" ->
- modified := true;
- copy_input last_start;
- Buffer.add_char output_buffer '?';
- Buffer.add_string output_buffer l;
- Buffer.add_string output_buffer ":(";
- input_pos := stop
- | QUESTION | LPAREN | LBRACE | SEMI | MINUSGREATER
- | EQUAL | COLON | COLONGREATER
- | VAL | MUTABLE | EXTERNAL | METHOD | OF ->
- if l0 = "fun" then begin
- modified := true;
- copy_input start;
- Buffer.add_string output_buffer l;
- Buffer.add_char output_buffer ':';
- input_pos := stop
- end
- | _ ->
- modified := true;
- copy_input start;
- Buffer.add_char output_buffer '~';
- Buffer.add_string output_buffer l;
- Buffer.add_char output_buffer ':';
- input_pos := stop
- end
- | LABELID l ->
- modified := true;
- begin match last_token with
- | PREFIXOP "?(" ->
- copy_input last_start;
- Buffer.add_string output_buffer "?(";
- Buffer.add_string output_buffer l;
- input_pos := stop
- | LPAREN ->
- copy_input last_start;
- Buffer.add_string output_buffer "~(";
- Buffer.add_string output_buffer l;
- input_pos := stop
- | QUESTION ->
- copy_input last_stop;
- Buffer.add_string output_buffer l;
- input_pos := stop
- | _ ->
- copy_input start;
- Buffer.add_char output_buffer '~';
- Buffer.add_string output_buffer l;
- input_pos := stop
- end
- | EOF -> raise End_of_file
- | _ -> ()
- end;
- if last_token = QUESTION && token = LPAREN then
- last := (PREFIXOP "?(", last_start, stop)
- else
- last := (token, start, stop)
- done with
- End_of_file ->
- copy_input (Buffer.length input_buffer)
-
-let convert_file name =
- let ic = open_in name in
- Buffer.clear input_buffer;
- Buffer.clear output_buffer;
- modified := false;
- begin
- try convert (Lexing.from_function (input_function ic)); close_in ic
- with exn -> close_in ic; raise exn
- end;
- if !modified then begin
- let backup = name ^ ".bak" in
- if Sys.file_exists backup then Sys.remove name
- else Sys.rename name backup;
- let oc = open_out name in
- Buffer.output_buffer oc output_buffer;
- close_out oc
- end
-
-let _ =
- if Array.length Sys.argv < 2 || Sys.argv.(1) = "-h" || Sys.argv.(1) = "-help"
- then begin
- print_endline "Usage: ocaml299to3 <source file> ...";
- print_endline "Description:";
- print_endline
- "Convert OCaml 2.99 O'Labl-style labels in implementation files to";
- print_endline
- "a syntax compatible with version 3. Also `fun:' labels are replaced \
- by `f:'.";
- print_endline "Other syntactic changes are not handled.";
- print_endline "Old files are renamed to <file>.bak.";
- print_endline "Interface files do not need label syntax conversion.";
- exit 0
- end;
- for i = 1 to Array.length Sys.argv - 1 do
- let name = Sys.argv.(i) in
- prerr_endline ("Converting " ^ name);
- Printexc.catch convert_file name
- done
exit 2
module Options = Main_args.Make_bytecomp_options (struct
- let _a () = make_archive := true
- let _absname = ignore
- let _alert = ignore
- let _annot = ignore
- let _binannot = ignore
- let _c = ignore
- let _cc = ignore
- let _cclib = ignore
- let _ccopt = ignore
- let _config = ignore
- let _config_var = ignore
- let _compat_32 = ignore
- let _custom = ignore
- let _dllib = ignore
- let _dllpath = ignore
- let _dtypes = ignore
- let _for_pack = ignore
- let _g = ignore
- let _stop_after = ignore
- let _i = ignore
- let _I = ignore
- let _impl _ = with_impl := true
- let _intf _ = with_intf := true
- let _intf_suffix = ignore
- let _keep_docs = ignore
- let _no_keep_docs = ignore
- let _keep_locs = ignore
- let _no_keep_locs = ignore
- let _labels = ignore
- let _linkall = ignore
- let _make_runtime = ignore
- let _alias_deps = ignore
- let _no_alias_deps = ignore
- let _app_funct = ignore
- let _no_app_funct = ignore
- let _no_check_prims = ignore
- let _noassert = ignore
- let _nolabels = ignore
- let _noautolink = ignore
- let _nostdlib = ignore
- let _o = ignore
- let _opaque = ignore
- let _open = ignore
- let _output_obj = ignore
- let _output_complete_obj = ignore
- let _pack = ignore
- let _plugin = ignore
- let _pp _ = incompatible "-pp"
- let _ppx _ = incompatible "-ppx"
- let _principal = ignore
- let _no_principal = ignore
- let _rectypes = ignore
- let _no_rectypes = ignore
- let _runtime_variant = ignore
- let _with_runtime = ignore
- let _without_runtime = ignore
- let _safe_string = ignore
- let _short_paths = ignore
- let _strict_sequence = ignore
- let _no_strict_sequence = ignore
- let _strict_formats = ignore
- let _no_strict_formats = ignore
- let _thread = ignore
- let _vmthread = ignore
- let _unboxed_types = ignore
- let _no_unboxed_types = ignore
- let _unsafe = ignore
- let _unsafe_string = ignore
- let _use_prims = ignore
- let _use_runtime = ignore
- let _v = ignore
- let _version = ignore
- let _vnum = ignore
- let _verbose = ignore
- let _w = ignore
- let _warn_error = ignore
- let _warn_help = ignore
- let _color = ignore
- let _error_style = ignore
- let _where = ignore
- let _nopervasives = ignore
- let _match_context_rows = ignore
- let _dump_into_file = ignore
- let _dno_unique_ids = ignore
- let _dunique_ids = ignore
- let _dsource = ignore
- let _dparsetree = ignore
- let _dtypedtree = ignore
- let _drawlambda = ignore
- let _dlambda = ignore
- let _dflambda = ignore
- let _dinstr = ignore
- let _dcamlprimc = ignore
- let _dtimings = ignore
- let _dprofile = ignore
- let _args = Arg.read_arg
- let _args0 = Arg.read_arg0
- let anonymous = process_file
-end);;
+ include Main_args.Default.Main
+ let _a () = make_archive := true
+ let _impl _ = with_impl := true
+ let _intf _ = with_intf := true
+ let _pp _ = incompatible "-pp"
+ let _ppx _ = incompatible "-ppx"
+ let anonymous = process_file
+ end);;
let rev_compargs = ref ([] : string list)
let rev_profargs = ref ([] : string list)
exit 2
module Options = Main_args.Make_optcomp_options (struct
+ include Main_args.Default.Optmain
let _a () = make_archive := true
- let _absname = ignore
- let _afl_instrument = ignore
- let _afl_inst_ratio = ignore
- let _alert = ignore
- let _annot = ignore
- let _binannot = ignore
- let _c = ignore
- let _cc = ignore
- let _cclib = ignore
- let _ccopt = ignore
- let _clambda_checks = ignore
- let _compact = ignore
- let _config = ignore
- let _config_var = ignore
- let _for_pack = ignore
- let _g = ignore
- let _stop_after = ignore
- let _i = ignore
- let _I = ignore
let _impl _ = with_impl := true
- let _inline = ignore
- let _inline_toplevel = ignore
- let _inlining_report = ignore
- let _dump_pass = ignore
- let _inline_max_depth = ignore
- let _rounds = ignore
- let _inline_max_unroll = ignore
- let _inline_call_cost = ignore
- let _inline_alloc_cost = ignore
- let _inline_prim_cost = ignore
- let _inline_branch_cost = ignore
- let _inline_indirect_cost = ignore
- let _inline_lifting_benefit = ignore
- let _inline_branch_factor = ignore
- let _classic_inlining = ignore
- let _insn_sched = ignore
let _intf _ = with_intf := true
- let _intf_suffix = ignore
- let _keep_docs = ignore
- let _no_keep_docs = ignore
- let _keep_locs = ignore
- let _no_keep_locs = ignore
- let _labels = ignore
- let _linkall = ignore
- let _alias_deps = ignore
- let _no_alias_deps = ignore
- let _app_funct = ignore
- let _no_app_funct = ignore
- let _no_float_const_prop = ignore
- let _noassert = ignore
- let _noautolink = ignore
- let _nodynlink = ignore
- let _no_insn_sched = ignore
- let _nolabels = ignore
- let _nostdlib = ignore
- let _no_unbox_free_vars_of_closures = ignore
- let _no_unbox_specialised_args = ignore
- let _o = ignore
- let _o2 = ignore
- let _o3 = ignore
- let _open = ignore
- let _output_obj = ignore
- let _output_complete_obj = ignore
- let _p = ignore
- let _pack = ignore
- let _plugin = ignore
let _pp _s = incompatible "-pp"
let _ppx _s = incompatible "-ppx"
- let _principal = ignore
- let _no_principal = ignore
- let _rectypes = ignore
- let _no_rectypes = ignore
- let _remove_unused_arguments = ignore
- let _runtime_variant = ignore
- let _with_runtime = ignore
- let _without_runtime = ignore
- let _S = ignore
- let _safe_string = ignore
- let _short_paths = ignore
- let _strict_sequence = ignore
- let _no_strict_sequence = ignore
- let _strict_formats = ignore
- let _no_strict_formats = ignore
- let _shared = ignore
- let _thread = ignore
- let _unbox_closures = ignore
- let _unbox_closures_factor = ignore
- let _unboxed_types = ignore
- let _no_unboxed_types = ignore
- let _unsafe = ignore
- let _unsafe_string = ignore
- let _v = ignore
- let _version = ignore
- let _vnum = ignore
- let _verbose = ignore
- let _w = ignore
- let _warn_error = ignore
- let _warn_help = ignore
- let _color = ignore
- let _error_style = ignore
- let _where = ignore
-
- let _linscan = ignore
- let _nopervasives = ignore
- let _match_context_rows = ignore
- let _dump_into_file = ignore
- let _dno_unique_ids = ignore
- let _dunique_ids = ignore
- let _dsource = ignore
- let _dparsetree = ignore
- let _dtypedtree = ignore
- let _drawlambda = ignore
- let _dlambda = ignore
- let _drawclambda = ignore
- let _dclambda = ignore
- let _drawflambda = ignore
- let _dflambda = ignore
- let _dflambda_invariants = ignore
- let _dflambda_no_invariants = ignore
- let _dflambda_let = ignore
- let _dflambda_verbose = ignore
- let _dcmm = ignore
- let _dsel = ignore
- let _dcombine = ignore
- let _dcse = ignore
- let _dlive = ignore
- let _davail = ignore
- let _drunavail = ignore
- let _dspill = ignore
- let _dsplit = ignore
- let _dinterf = ignore
- let _dprefer = ignore
- let _dalloc = ignore
- let _dreload = ignore
- let _dscheduling = ignore
- let _dlinear = ignore
- let _dstartup = ignore
- let _dinterval = ignore
- let _dtimings = ignore
- let _dprofile = ignore
- let _opaque = ignore
-
let _args = Arg.read_arg
let _args0 = Arg.read_arg0
let anonymous = process_file
match smod.pmod_desc with
Pmod_ident _ -> ()
| Pmod_structure sstr -> List.iter (rewrite_str_item iflag) sstr
- | Pmod_functor(_param, _smty, sbody) -> rewrite_mod iflag sbody
+ | Pmod_functor(_param, sbody) -> rewrite_mod iflag sbody
| Pmod_apply(smod1, smod2) -> rewrite_mod iflag smod1; rewrite_mod iflag smod2
| Pmod_constraint(smod, _smty) -> rewrite_mod iflag smod
| Pmod_unpack(sexp) -> rewrite_exp iflag sexp
rm -f /tmp/env-$USER.sh
cat >/tmp/env-$USER.sh <<EOF
-export WORKTREE=~/o/4.08
- # must be the git worktree for the branch you are releasing
-
export MAJOR=4
export MINOR=08
export BUGFIX=0
-export PLUSEXT=+beta3
+export PLUSEXT=
+
+export WORKTREE=~/o/\$MAJOR.\$MINOR
+ # must be the git worktree for the branch you are releasing
export BRANCH=\$MAJOR.\$MINOR
export VERSION=\$MAJOR.\$MINOR.\$BUGFIX\$PLUSEXT
rm -rf ${INSTDIR}
./configure -prefix ${INSTDIR}
-make world.opt -j5
+make -j5
make alldepend
- # note: you have to run 'alldepend' after 'world',
- # not just after 'core' as before, because
- # ocamldoc/stdlib_non_prefixed depends on 'world'
# check that .depend files have no absolute path in them
find . -name .depend | xargs grep ' /'
# 4.07.0+dev8-2018-06-19 => 4.07.0+dev9-2018-06-26
# for production releases: check and change the Changes header
# (remove "next version" and add a date)
-# Update ocaml-variants.opam file to depend on the new version of ocaml.
-git add VERSION Changes ocaml-variants.opam
-git commit -m "last commit before tagging $VERSION"
+./autogen
+git commit -a -m "last commit before tagging $VERSION"
+
# update VERSION with the new release; for example,
# 4.07.0+dev9-2018-06-26 => 4.07.0+rc2
+# Update ocaml-variants.opam with new version.
+# Update \year in manual/manual/macros.hva
+rm -r autom4te.cache
+./autogen
make coreboot -j5
make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded."
-git commit -m "change VERSION for $VERSION" -a
+git commit -m "release $VERSION" -a
git tag -m "release $VERSION" $VERSION
# for production releases, change the VERSION file into (N+1)+dev0; for example,
# 4.08.0 => 4.08.1+dev0
# for testing candidates, use N+dev(D+2) instead; for example,
# 4.07.0+rc2 => 4.07.0+dev10-2018-06-26
-git commit -m "increment version number after tagging $VERSION" VERSION
+# Revert ocaml-variants.opam to its "trunk" version.
+rm -r autom4te.cache
+./autogen
+git commit -m "increment version number after tagging $VERSION" VERSION configure ocaml-variants.opam
git push
git push --tags
```
+## 5.1: create the release on github (only for a production release)
-## 6: create OPAM switches
+open https://github.com/ocaml/ocaml/releases
+# and click "Draft a new release"
+# for a minor release, the description is:
+ Bug fixes. See [detailed list of changes](https://github.com/ocaml/ocaml/blob/$MAJOR.$MINOR/Changes).
-Create OPAM switches for the new version, copying the particular
-switch configuration choices from the previous version.
-
-We currently use a semi-automated process, copying and batch-editing
-the compiler descriptions from the last release. The instructions
-below assume an opam1 repository organization, an opam2 repository
-will have a different layout.
-
-From a branch of the opam-repository, in `compilers/$MAJOR.$MINOR.$BUGFIX`:
-
-```
-cd .../opam-repository/packages/ocaml-variants
-# copy foo+rc2+... switches into foo+rc3+...
-OLD_DIRS=*+rc2*
-VER="s/+rc2/+rc3/g"
-NEW_DIRS=""
-for f in $OLD_DIRS; do NEW_DIRS="$NEW_DIRS $(echo $f | sed $VER)"; done
-echo $NEW_DIRS # for checking
+## 6: create OPAM packages
-for f in $OLD_DIRS; do
- mkdir -p $(echo $f | sed $VER)
- for file in $f/*; do
- cp $file $(echo $file | sed $VER)
- # we copy the file, but their content still corresponds to the old version
- done
- git add $(echo $f | sed $VER)
-done
-
-git status
- # inspect the new filenames
-
-for f in $NEW_DIRS; do sed -i $VER $f/*; done
-git diff # inspect the result of this last change
-
-git add $NEW_DIRS
-
-# the strings below work on .descr files,
-# they may need to be adapted
-for f in $NEW_DIRS; do
- sed -i "s/rc2/rc3/g" $f/*
- sed -i "s/Second release candidate/Third release candidate/g" $f/*
-done
-git diff # inspect the result of this last change
-
-git add $NEW_DIRS
-
-git diff --cached # inspect the complete result
+Create ocaml-variants packages for the new version, copying the particular
+switch configuration choices from the previous version.
-git commit -m "OPAM switches for $VERSION"
-```
+Do not forget to add/update the checksum field for the tarballs in the
+"url" section of the opam files. Use opam-lint before sending the pull
+request.
## 7: build the release archives
```
cd $WORKTREE
-make world.opt
+make
make install
export PATH="$INSTDIR/bin:$PATH"
cd manual
cd $WEB_PATH/caml/pub/docs
mkdir -p manual-ocaml-$BRANCH
cd manual-ocaml-$BRANCH
+rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
wget http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$BRANCH-refman-html.tar.gz
tar -xzvf ocaml-$BRANCH-refman-html.tar.gz # this extracts into htmlman/
-cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH
-rm -fR htmlman
+/bin/cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH
+rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
cd $WEB_PATH/caml/pub/docs
+rm manual-ocaml
ln -sf manual-ocaml-$BRANCH manual-ocaml
```
<https://github.com/ocaml/ocaml.org/issues/819>
-## 12: update Mantis
-
-(this section intentionally left blank)
-
## 13: announce the release on caml-list and caml-announce
See the email announce templates at the end of this file.
```
Dear OCaml users,
-The release of OCaml version <version> is imminent. We have
-created a <release candidate/beta version> for your testing pleasure. Please
-download the sources, compile, install, and test your favourite
-software with it. Then let me know whether it works for you.
+The release of OCaml version $MAJOR.$MINOR.$BUGFIX is imminent. We have
+created a release candidate that you can test.
+
+The source code is available at these addresses:
+
+ https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$VERSION.tar.gz
-We want to know about any show-stopping bugs, especially in the
-compilation and installation phases.
+The compiler can also be installed as an OPAM switch with one of the
+following commands.
+
+opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+or
-This <release candidate/beta version> is available as source code at this
-address: < http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ >
+opam switch create ocaml-variants.$VERSION+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+ where you replace <VARIANT> with one of these:
+ afl
+ default-unsafe-string
+ force-safe-string
+ flambda
+ fp
+ fp+flambda
+
+We want to know about all bugs. Please report them here:
+ https://github.com/ocaml/ocaml/issues
Happy hacking,
```
Dear OCaml users,
-The release of OCaml 4.08.0 is approaching. We have created
+The release of OCaml $MAJOR.$MINOR.$BUGFIX is approaching. We have created
a beta version to help you adapt your software to the new features
ahead of the release.
The source code is available at these addresses:
- https://github.com/ocaml/ocaml/archive/4.08.0+beta1.tar.gz
- https://caml.inria.fr/pub/distrib/ocaml-4.08/ocaml-4.08.0+beta1.tar.gz
+ https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/$VERSION.tar.gz
The compiler can also be installed as an OPAM switch with one of the
following commands.
-opam switch create ocaml-variants.4.08.0+beta1 --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
or
-opam switch create ocaml-variants.4.08.0+beta1+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+opam switch create ocaml-variants.$VERSION+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
where you replace <VARIANT> with one of these:
afl
- default_unsafe_string
+ default-unsafe-string
+ force-safe-string
flambda
fp
fp+flambda
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Jacques Garrigue, Kyoto University RIMS *)
-(* *)
-(* Copyright 2001 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-open StdLabels
-open Lexer301
-
-let input_buffer = Buffer.create 16383
-let input_function ic buf len =
- let len = input ic buf 0 len in
- Buffer.add_substring input_buffer buf 0 len;
- len
-
-let output_buffer = Buffer.create 16383
-
-let modified = ref false
-
-let modules =
- ref [ "Arg"; "BigArray"; "Buffer"; "Condition"; "Dbm"; "Digest"; "Dynlink";
- "Event"; "Filename"; "Format"; "Gc"; "Genlex";
- "Lexing"; "Marshal"; "Mutex"; "Parsing"; "Pervasives"; "Queue";
- "Stack"; "Str"; "Stream"; "Sys";
- "Thread"; "ThreadUnix"; "Weak" ]
-
-let stdlabels = ["Array"; "List"; "String"]
-let morelabels = ["Hashtbl"; "Map"; "Set"]
-let alllabels = ref false
-let noopen = ref false
-
-exception Closing of token
-
-let convert_impl buffer =
- let input_pos = ref 0 in
- let copy_input stop =
- Buffer.add_substring output_buffer (Buffer.contents input_buffer)
- !input_pos (stop - !input_pos);
- input_pos := stop
- in
- let next_token () =
- let token = Lexer301.token buffer
- and start = Lexing.lexeme_start buffer
- and stop = Lexing.lexeme_end buffer in
- match token with
- RPAREN | RBRACKET |BARRBRACKET | GREATERRBRACKET | END
- | RBRACE | GREATERRBRACE ->
- raise (Closing token)
- | EOF ->
- raise End_of_file
- | _ ->
- (token, start, stop)
- in
- let openunix = ref None and openstd = ref None and openmore = ref None in
- let rec may_start (token, s, e) =
- match token with
- LIDENT _ -> search_start (dropext (next_token ()))
- | UIDENT m when List.mem m !modules ->
- may_discard (dropext (next_token ()))
- | UIDENT m ->
- List.iter ~f:
- (fun (set,r) ->
- if !r = None && List.mem m ~set then r := Some true)
- [stdlabels, openstd; ["Unix"], openunix; morelabels, openmore];
- search_start (next_token ())
- | _ -> search_start (token, s, e)
-
- and dropext (token, s, e) =
- match token with
- DOT ->
- let (token, s, e) = next_token () in
- begin match token with
- LPAREN | LBRACKET | LBRACE ->
- process_paren (token, s, e);
- dropext (next_token ())
- | UIDENT _ | LIDENT _ ->
- dropext (next_token ())
- | _ ->
- prerr_endline ("bad index at position " ^ Int.to_string s);
- (token, s, e)
- end
- | _ ->
- (token, s, e)
-
- and may_discard (token, s, e) =
- match token with
- TILDE | LABEL _ ->
- modified := true;
- copy_input s; input_pos := e;
- may_discard (next_token ())
- | _ when !alllabels ->
- may_discard (next_token ())
- | LPAREN | LBRACKET | LBRACKETBAR | LBRACKETLESS | BEGIN
- | LBRACE | LBRACELESS | STRUCT | SIG | OBJECT->
- process_paren (token, s, e);
- may_discard (next_token ())
- | PREFIXOP _ ->
- may_discard (next_token ())
- | LIDENT _ | UIDENT _ ->
- may_discard (dropext (next_token ()))
- | BACKQUOTE ->
- ignore (next_token ());
- may_discard (next_token ())
- | INT _ | CHAR _ | STRING _ | FLOAT _ | FALSE | TRUE ->
- may_discard (next_token ())
- | _ ->
- search_start (token, s, e)
-
- and search_start (token, s, e) =
- match token with
- LPAREN | LBRACKET | LBRACKETBAR | LBRACKETLESS | BEGIN
- | LBRACE | LBRACELESS | STRUCT | SIG | OBJECT ->
- process_paren (token, s, e);
- search_start (next_token ())
- | EQUAL | SEMI | SEMISEMI | MINUSGREATER | LESSMINUS | COMMA
- | IF | THEN | ELSE | WHILE | TO | DOWNTO | DO | IN | MATCH | TRY
- | INFIXOP0 _ | INFIXOP1 _ | INFIXOP2 _ | INFIXOP3 _ | INFIXOP4 _
- | PLUS | MINUS | MINUSDOT | STAR | LESS | GREATER
- | OR | BARBAR | AMPERSAND | AMPERAMPER | COLONEQUAL ->
- may_start (next_token ())
- | OPEN ->
- begin match next_token () with
- | UIDENT m, _, _ ->
- List.iter
- ~f:(fun (set,r) -> if List.mem m ~set then r := Some false)
- [stdlabels, openstd; ["Unix"], openunix; morelabels, openmore]
- | _ -> ()
- end;
- search_start (next_token ())
- | _ ->
- search_start (next_token ())
-
- and process_paren (token, s, e) =
- try match token with
- LPAREN | LBRACKET | LBRACKETBAR | LBRACKETLESS | BEGIN ->
- may_start (next_token ())
- | LBRACE | LBRACELESS | STRUCT | SIG | OBJECT ->
- search_start (next_token ())
- | _ ->
- assert false
- with Closing last ->
- match token, last with
- LPAREN, RPAREN
- | (LBRACKET|LBRACKETBAR|LBRACKETLESS),
- (RBRACKET|BARRBRACKET|GREATERRBRACKET)
- | (BEGIN|STRUCT|SIG|OBJECT), END
- | LBRACE, RBRACE
- | LBRACELESS, GREATERRBRACE -> ()
- | _ -> raise (Closing last)
- in
- let first = next_token () in
- try
- if !alllabels then may_discard first else may_start first
- with End_of_file ->
- copy_input (Buffer.length input_buffer);
- if not !alllabels
- && List.exists (fun r -> !r = Some true) [openstd; openunix; openmore]
- then begin
- modified := true;
- let text = Buffer.contents output_buffer in
- Buffer.clear output_buffer;
- let (token, s, _) = first in
- Buffer.add_substring output_buffer text 0 s;
- List.iter ~f:
- (fun (r, s) ->
- if !r = Some true then Buffer.add_string output_buffer s)
- [ openstd, "open StdLabels\n"; openmore, "open MoreLabels\n";
- openunix, "module Unix = UnixLabels\n" ];
- let sep =
- if List.mem token [CLASS; EXTERNAL; EXCEPTION; FUNCTOR; LET;
- MODULE; FUNCTOR; TYPE; VAL]
- then "\n"
- else if token = OPEN then "" else ";;\n\n"
- in
- Buffer.add_string output_buffer sep;
- Buffer.add_substring output_buffer text s (String.length text - s)
- end
- | Closing _ ->
- prerr_endline ("bad closing token at position " ^
- Int.to_string (Lexing.lexeme_start buffer));
- modified := false
-
-type state = Out | Enter | In | Escape
-
-let convert_intf buffer =
- let input_pos = ref 0 in
- let copy_input stop =
- Buffer.add_substring output_buffer (Buffer.contents input_buffer)
- !input_pos (stop - !input_pos);
- input_pos := stop
- in
- let last = ref (EOF, 0, 0) in
- let state = ref Out in
- try while true do
- let token = Lexer301.token buffer
- and start = Lexing.lexeme_start buffer
- and stop = Lexing.lexeme_end buffer
- and last_token, last_start, last_stop = !last in
- begin match token with
- | EXCEPTION | CONSTRAINT ->
- state := In
- | VAL | EXTERNAL | CLASS | METHOD | TYPE | AND ->
- state := Enter
- | EQUAL when !state = Enter ->
- state := In
- | COLON ->
- begin match !state, last_token with
- | In, LIDENT _ ->
- modified := true;
- copy_input last_start;
- input_pos := stop
- | Enter, _ ->
- state := In
- | Escape, _ ->
- state := In
- | _ ->
- state := Out
- end
- | LBRACE | SEMI | QUESTION when !state = In ->
- state := Escape
- | SEMISEMI | SIG | STRUCT | END | OBJECT | OPEN | INCLUDE | MODULE ->
- state := Out
- | EOF -> raise End_of_file
- | _ -> ()
- end;
- last := (token, start, stop)
- done with
- End_of_file ->
- copy_input (Buffer.length input_buffer)
-
-let convert_file ~intf name =
- let ic = open_in name in
- Buffer.clear input_buffer;
- Buffer.clear output_buffer;
- modified := false;
- begin
- let convert = if intf then convert_intf else convert_impl in
- try convert (Lexing.from_function (input_function ic)); close_in ic
- with exn -> close_in ic; raise exn
- end;
- if !modified then begin
- let backup = name ^ ".bak" in
- if Sys.file_exists backup then Sys.remove name
- else Sys.rename name backup;
- let oc = open_out name in
- Buffer.output_buffer oc output_buffer;
- close_out oc
- end
- else prerr_endline ("No changes in " ^ name)
-
-let _ =
- let files = ref [] and intf = ref false
- and keepstd = ref false and keepmore = ref false in
- Arg.parse
- [ "-intf", Arg.Set intf,
- " remove all non-optional labels from an interface;\n" ^
- " other options are ignored";
- "-all", Arg.Set alllabels,
- " remove all labels, possibly including optional ones!";
- "-keepstd", Arg.Set keepstd,
- " keep labels for Array, List, String and Unix";
- "-keepmore", Arg.Set keepmore,
- " keep also labels for Hashtbl, Map and Set; implies -keepstd";
- "-m", Arg.String (fun s -> modules := s :: !modules),
- "<module> remove also labels for <module>";
- "-noopen", Arg.Set noopen,
- " do not insert `open' statements for -keepstd/-keepmore" ]
- (fun s -> files := s :: !files)
- ("Usage: scrapelabels <options> <source files>\n" ^
- " Remove labels from function arguments in standard library modules.\n" ^
- " With -intf option below, can also process interfaces.\n" ^
- " Old files are renamed to <file>.bak if there is no backup yet.\n" ^
- "Options are:");
- if !keepmore then keepstd := true;
- if not !keepstd then modules := "Unix" :: stdlabels @ !modules;
- if not !keepmore then modules := morelabels @ !modules;
- List.iter (List.rev !files) ~f:
- begin fun name ->
- prerr_endline ("Processing " ^ name);
- Printexc.catch (convert_file ~intf:!intf) name
- end
it comes from. Attempt to omit the prefix if the type comes from
a module that has been opened. *)
- let tree_of_qualified lookup_fun env ty_path name =
+ let tree_of_qualified find env ty_path name =
match ty_path with
| Pident _ ->
Oide_ident name
| Pdot(p, _s) ->
- if try
- match (lookup_fun (Lident (Out_name.print name)) env).desc with
- | Tconstr(ty_path', _, _) -> Path.same ty_path ty_path'
- | _ -> false
- with Not_found -> false
+ if
+ match (find (Lident (Out_name.print name)) env).desc with
+ | Tconstr(ty_path', _, _) -> Path.same ty_path ty_path'
+ | _ -> false
+ | exception Not_found -> false
then Oide_ident name
else Oide_dot (Printtyp.tree_of_path p, Out_name.print name)
| Papply _ ->
let tree_of_constr =
tree_of_qualified
- (fun lid env -> (Env.lookup_constructor lid env).cstr_res)
+ (fun lid env ->
+ (Env.find_constructor_by_name lid env).cstr_res)
and tree_of_label =
- tree_of_qualified (fun lid env -> (Env.lookup_label lid env).lbl_res)
+ tree_of_qualified
+ (fun lid env ->
+ (Env.find_label_by_name lid env).lbl_res)
(* An abstract type *)
try
(* Attempt to recover the constructor description for the exn
from its name *)
- let cstr = Env.lookup_constructor lid env in
+ let cstr = Env.find_constructor_by_name lid env in
let path =
match cstr.cstr_tag with
Cstr_extension(p, _) -> p
Env.t -> t -> type_expr -> Outcometree.out_value
end
-module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) :
+module Make(O : OBJ)(_ : EVALPATH with type valu = O.t) :
(S with type t = O.t)
let match_printer_type ppf desc typename =
let printer_type =
- try
- Env.lookup_type (Ldot(Lident "Opttopdirs", typename)) !toplevel_env
- with Not_found ->
- fprintf ppf "Cannot find type Topdirs.%s.@." typename;
- raise Exit in
+ match
+ Env.find_type_by_name
+ (Ldot(Lident "Opttopdirs", typename)) !toplevel_env
+ with
+ | (path, _) -> path
+ | exception Not_found ->
+ fprintf ppf "Cannot find type Topdirs.%s.@." typename;
+ raise Exit
+ in
Ctype.begin_def();
let ty_arg = Ctype.newvar() in
Ctype.unify !toplevel_env
ty_arg
let find_printer_type ppf lid =
- try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
- let (ty_arg, is_old_style) =
- try
- (match_printer_type ppf desc "printer_type_new", false)
- with Ctype.Unify _ ->
- (match_printer_type ppf desc "printer_type_old", true) in
- (ty_arg, path, is_old_style)
- with
- | Not_found ->
+ match Env.find_value_by_name lid !toplevel_env with
+ | (path, desc) -> begin
+ match match_printer_type ppf desc "printer_type_new" with
+ | ty_arg -> (ty_arg, path, false)
+ | exception Ctype.Unify _ -> begin
+ match match_printer_type ppf desc "printer_type_old" with
+ | ty_arg -> (ty_arg, path, true)
+ | exception Ctype.Unify _ ->
+ fprintf ppf "%a has a wrong type for a printing function.@."
+ Printtyp.longident lid;
+ raise Exit
+ end
+ end
+ | exception Not_found ->
fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
raise Exit
- | Ctype.Unify _ ->
- fprintf ppf "%a has a wrong type for a printing function.@."
- Printtyp.longident lid;
- raise Exit
let dir_install_printer ppf lid =
try
[ Ptop_def
[ Str.module_
(Mb.mk
- (Location.mknoloc modname)
+ (Location.mknoloc (Some modname))
(Mod.structure items)
)
]
if !Clflags.keep_asm_file then !phrase_name ^ ext_dll
else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
in
- let fn = Filename.chop_extension dll in
- if not Config.flambda then
- Asmgen.compile_implementation_clambda
- ~toplevel:need_symbol fn ~backend ~ppf_dump:ppf
- { Lambda.code=slam ; main_module_block_size=size;
- module_ident; required_globals }
- else
- Asmgen.compile_implementation_flambda
- ~required_globals ~backend ~toplevel:need_symbol fn ~ppf_dump:ppf
- (Flambda_middle_end.middle_end ~ppf_dump:ppf ~prefixname:fn ~backend ~size
- ~module_ident ~module_initializer:slam ~filename:"toplevel");
- Asmlink.call_linker_shared [fn ^ ext_obj] dll;
- Sys.remove (fn ^ ext_obj);
+ let filename = Filename.chop_extension dll in
+ let program =
+ { Lambda.
+ code = slam;
+ main_module_block_size = size;
+ module_ident;
+ required_globals;
+ }
+ in
+ let middle_end =
+ if Config.flambda then Flambda_middle_end.lambda_to_clambda
+ else Closure_middle_end.lambda_to_clambda
+ in
+ Asmgen.compile_implementation ~toplevel:need_symbol
+ ~backend ~filename ~prefixname:filename
+ ~middle_end ~ppf_dump:ppf program;
+ Asmlink.call_linker_shared [filename ^ ext_obj] dll;
+ Sys.remove (filename ^ ext_obj);
let dll =
if Filename.is_implicit dll
Clflags.dlcode := true;
()
+let find_ocamlinit () =
+ let ocamlinit = ".ocamlinit" in
+ if Sys.file_exists ocamlinit then Some ocamlinit else
+ let getenv var = match Sys.getenv var with
+ | exception Not_found -> None | "" -> None | v -> Some v
+ in
+ let exists_in_dir dir file = match dir with
+ | None -> None
+ | Some dir ->
+ let file = Filename.concat dir file in
+ if Sys.file_exists file then Some file else None
+ in
+ let home_dir () = getenv "HOME" in
+ let config_dir () =
+ if Sys.win32 then None else
+ match getenv "XDG_CONFIG_HOME" with
+ | Some _ as v -> v
+ | None ->
+ match home_dir () with
+ | None -> None
+ | Some dir -> Some (Filename.concat dir ".config")
+ in
+ let init_ml = Filename.concat "ocaml" "init.ml" in
+ match exists_in_dir (config_dir ()) init_ml with
+ | Some _ as v -> v
+ | None -> exists_in_dir (home_dir ()) ocamlinit
+
let load_ocamlinit ppf =
if !Clflags.noinit then ()
else match !Clflags.init_file with
| Some f -> if Sys.file_exists f then ignore (use_silently ppf f)
else fprintf ppf "Init file not found: \"%s\".@." f
| None ->
- if Sys.file_exists ".ocamlinit" then ignore (use_silently ppf ".ocamlinit")
- else try
- let home_init = Filename.concat (Sys.getenv "HOME") ".ocamlinit" in
- if Sys.file_exists home_init then ignore (use_silently ppf home_init)
- with Not_found -> ()
+ match find_ocamlinit () with
+ | None -> ()
+ | Some file -> ignore (use_silently ppf file)
;;
let set_paths () =
else exit 2
end
-let print_version () =
- Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
- exit 0;
-;;
-
-let print_version_num () =
- Printf.printf "%s\n" Sys.ocaml_version;
- exit 0;
-;;
-
let wrap_expand f s =
let start = !current in
let arr = f s in
arr
module Options = Main_args.Make_opttop_options (struct
- let set r () = r := true
- let clear r () = r := false
-
- let _absname = set absname
- let _alert = Warnings.parse_alert_option
- let _compact = clear optimize_for_speed
- let _I dir = include_dirs := dir :: !include_dirs
- let _init s = init_file := Some s
- let _noinit = set noinit
- let _clambda_checks () = clambda_checks := true
- let _inline spec =
- Float_arg_helper.parse spec
- "Syntax: -inline <n> | <round>=<n>[,...]"
- inline_threshold
- let _inline_indirect_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-indirect-cost <n> | <round>=<n>[,...]"
- inline_indirect_cost
- let _inline_toplevel spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-toplevel <n> | <round>=<n>[,...]"
- inline_toplevel_threshold
- let _inlining_report () = inlining_report := true
- let _dump_pass pass = set_dumped_pass pass true
- let _rounds n = simplify_rounds := Some n
- let _inline_max_unroll spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-unroll <n> | <round>=<n>[,...]"
- inline_max_unroll
- let _classic_inlining () = classic_inlining := true
- let _inline_call_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-call-cost <n> | <round>=<n>[,...]"
- inline_call_cost
- let _inline_alloc_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-alloc-cost <n> | <round>=<n>[,...]"
- inline_alloc_cost
- let _inline_prim_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-prim-cost <n> | <round>=<n>[,...]"
- inline_prim_cost
- let _inline_branch_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-branch-cost <n> | <round>=<n>[,...]"
- inline_branch_cost
- let _inline_lifting_benefit spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-lifting-benefit <n> | <round>=<n>[,...]"
- inline_lifting_benefit
- let _inline_branch_factor spec =
- Float_arg_helper.parse spec
- "Syntax: -inline-branch-factor <n> | <round>=<n>[,...]"
- inline_branch_factor
- let _inline_max_depth spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-depth <n> | <round>=<n>[,...]"
- inline_max_depth
- let _insn_sched = set insn_sched
- let _no_insn_sched = clear insn_sched
- let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
- let _no_unbox_specialised_args = clear unbox_specialised_args
- let _o s = output_name := Some s
- let _o2 () =
- default_simplify_rounds := 2;
- use_inlining_arguments_set o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _o3 () =
- default_simplify_rounds := 3;
- use_inlining_arguments_set o3_arguments;
- use_inlining_arguments_set ~round:1 o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _remove_unused_arguments = set remove_unused_arguments
- let _unbox_closures = set unbox_closures
- let _unbox_closures_factor f = unbox_closures_factor := f
- let _drawclambda = set dump_rawclambda
- let _dclambda = set dump_clambda
- let _drawflambda = set dump_rawflambda
- let _dflambda = set dump_flambda
- let _dflambda_let stamp = dump_flambda_let := Some stamp
- let _dflambda_verbose () =
- set dump_flambda ();
- set dump_flambda_verbose ()
- let _dflambda_invariants = set flambda_invariant_checks
- let _dflambda_no_invariants = clear flambda_invariant_checks
- let _labels = clear classic
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _dlinscan = set use_linscan
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noprompt = set noprompt
- let _nopromptcont = set nopromptcont
- let _nostdlib = set no_std_include
- let _nopervasives = set nopervasives
- let _ppx s = Compenv.first_ppx := s :: !Compenv.first_ppx
- let _principal = set principal
- let _no_principal = clear principal
- let _real_paths = set real_paths
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _S = set keep_asm_file
- let _short_paths = clear real_paths
- let _stdin () = file_argument ""
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _verbose = set verbose
- let _version () = print_version ()
- let _vnum () = print_version_num ()
- let _no_version = set noversion
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
-
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _drawclambda = set dump_rawclambda
- let _dclambda = set dump_clambda
- let _dcmm = set dump_cmm
- let _dsel = set dump_selection
- let _dcombine = set dump_combine
- let _dcse = set dump_cse
- let _dlive () = dump_live := true; Printmach.print_live := true
- let _davail () = dump_avail := true
- let _drunavail () = debug_runavail := true
- let _dspill = set dump_spill
- let _dsplit = set dump_split
- let _dinterf = set dump_interf
- let _dprefer = set dump_prefer
- let _dalloc = set dump_regalloc
- let _dreload = set dump_reload
- let _dscheduling = set dump_scheduling
- let _dlinear = set dump_linear
- let _dinterval = set dump_interval
- let _dstartup = set keep_startup_file
- let _safe_string = clear unsafe_string
- let _unsafe_string = set unsafe_string
- let _open s = open_modules := s :: !open_modules
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
-
- let _args = wrap_expand Arg.read_arg
- let _args0 = wrap_expand Arg.read_arg0
-
- let anonymous = file_argument
+ include Main_args.Default.Opttopmain
+ let _stdin () = file_argument ""
+ let _args = wrap_expand Arg.read_arg
+ let _args0 = wrap_expand Arg.read_arg0
+ let anonymous s = file_argument s
end);;
let () =
let printer_type ppf typename =
let printer_type =
- try
- Env.lookup_type (Ldot(Lident "Topdirs", typename)) !toplevel_env
- with Not_found ->
- fprintf ppf "Cannot find type Topdirs.%s.@." typename;
- raise Exit in
+ match
+ Env.find_type_by_name
+ (Ldot(Lident "Topdirs", typename)) !toplevel_env
+ with
+ | path, _ -> path
+ | exception Not_found ->
+ fprintf ppf "Cannot find type Topdirs.%s.@." typename;
+ raise Exit
+ in
printer_type
let match_simple_printer_type desc printer_type =
false)
let find_printer_type ppf lid =
- try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
- let (ty_arg, is_old_style) = match_printer_type ppf desc in
- (ty_arg, path, is_old_style)
- with
- | Not_found ->
- fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
- raise Exit
- | Ctype.Unify _ ->
+ match Env.find_value_by_name lid !toplevel_env with
+ | (path, desc) -> begin
+ match match_printer_type ppf desc with
+ | (ty_arg, is_old_style) -> (ty_arg, path, is_old_style)
+ | exception Ctype.Unify _ ->
fprintf ppf "%a has a wrong type for a printing function.@."
Printtyp.longident lid;
raise Exit
+ end
+ | exception Not_found ->
+ fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
+ raise Exit
let dir_install_printer ppf lid =
try
(Obj.repr (fun arg -> Trace.print_trace (current_environment()) arg))
let dir_trace ppf lid =
- try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
- (* Check if this is a primitive *)
- match desc.val_kind with
- | Val_prim _ ->
- fprintf ppf "%a is an external function and cannot be traced.@."
- Printtyp.longident lid
- | _ ->
- let clos = eval_value_path !toplevel_env path in
- (* Nothing to do if it's not a closure *)
- if Obj.is_block clos
- && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
- && (match Ctype.(repr (expand_head !toplevel_env desc.val_type))
- with {desc=Tarrow _} -> true | _ -> false)
- then begin
- match is_traced clos with
- | Some opath ->
- fprintf ppf "%a is already traced (under the name %a).@."
- Printtyp.path path
- Printtyp.path opath
- | None ->
- (* Instrument the old closure *)
- traced_functions :=
- { path = path;
- closure = clos;
- actual_code = get_code_pointer clos;
- instrumented_fun =
- instrument_closure !toplevel_env lid ppf desc.val_type }
- :: !traced_functions;
- (* Redirect the code field of the closure to point
- to the instrumentation function *)
- set_code_pointer clos tracing_function_ptr;
- fprintf ppf "%a is now traced.@." Printtyp.longident lid
- end else fprintf ppf "%a is not a function.@." Printtyp.longident lid
- with
- | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+ match Env.find_value_by_name lid !toplevel_env with
+ | (path, desc) -> begin
+ (* Check if this is a primitive *)
+ match desc.val_kind with
+ | Val_prim _ ->
+ fprintf ppf "%a is an external function and cannot be traced.@."
+ Printtyp.longident lid
+ | _ ->
+ let clos = eval_value_path !toplevel_env path in
+ (* Nothing to do if it's not a closure *)
+ if Obj.is_block clos
+ && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
+ && (match Ctype.(repr (expand_head !toplevel_env desc.val_type))
+ with {desc=Tarrow _} -> true | _ -> false)
+ then begin
+ match is_traced clos with
+ | Some opath ->
+ fprintf ppf "%a is already traced (under the name %a).@."
+ Printtyp.path path
+ Printtyp.path opath
+ | None ->
+ (* Instrument the old closure *)
+ traced_functions :=
+ { path = path;
+ closure = clos;
+ actual_code = get_code_pointer clos;
+ instrumented_fun =
+ instrument_closure !toplevel_env lid ppf desc.val_type }
+ :: !traced_functions;
+ (* Redirect the code field of the closure to point
+ to the instrumentation function *)
+ set_code_pointer clos tracing_function_ptr;
+ fprintf ppf "%a is now traced.@." Printtyp.longident lid
+ end else fprintf ppf "%a is not a function.@." Printtyp.longident lid
+ end
+ | exception Not_found ->
+ fprintf ppf "Unbound value %a.@." Printtyp.longident lid
let dir_untrace ppf lid =
- try
- let (path, _desc) = Env.lookup_value lid !toplevel_env in
- let rec remove = function
- | [] ->
- fprintf ppf "%a was not traced.@." Printtyp.longident lid;
- []
- | f :: rem ->
- if Path.same f.path path then begin
- set_code_pointer f.closure f.actual_code;
- fprintf ppf "%a is no longer traced.@." Printtyp.longident lid;
- rem
- end else f :: remove rem in
- traced_functions := remove !traced_functions
- with
- | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+ match Env.find_value_by_name lid !toplevel_env with
+ | (path, _desc) ->
+ let rec remove = function
+ | [] ->
+ fprintf ppf "%a was not traced.@." Printtyp.longident lid;
+ []
+ | f :: rem ->
+ if Path.same f.path path then begin
+ set_code_pointer f.closure f.actual_code;
+ fprintf ppf "%a is no longer traced.@." Printtyp.longident lid;
+ rem
+ end else f :: remove rem in
+ traced_functions := remove !traced_functions
+ | exception Not_found ->
+ fprintf ppf "Unbound value %a.@." Printtyp.longident lid
let dir_untrace_all ppf () =
List.iter
let () =
reg_show_prim "show_val"
(fun env loc id lid ->
- let _path, desc = Typetexp.find_value env loc lid in
+ let _path, desc = Env.lookup_value ~loc lid env in
[ Sig_value (id, desc, Exported) ]
)
"Print the signature of the corresponding value."
let () =
reg_show_prim "show_type"
(fun env loc id lid ->
- let _path, desc = Typetexp.find_type env loc lid in
+ let _path, desc = Env.lookup_type ~loc lid env in
[ Sig_type (id, desc, Trec_not, Exported) ]
)
"Print the signature of the corresponding type constructor."
let () =
reg_show_prim "show_exception"
(fun env loc id lid ->
- let desc = Typetexp.find_constructor env loc lid in
+ let desc = Env.lookup_constructor ~loc Env.Positive lid env in
if not (Ctype.equal env true [desc.cstr_res] [Predef.type_exn]) then
raise Not_found;
let ret_type =
let () =
reg_show_prim "show_module"
(fun env loc id lid ->
- let rec accum_aliases path acc =
- let md = Env.find_module path env in
+ let rec accum_aliases md acc =
let acc =
Sig_module (id, Mp_present,
{md with md_type = trim_signature md.md_type},
Trec_not, Exported) :: acc in
match md.md_type with
- | Mty_alias path -> accum_aliases path acc
+ | Mty_alias path ->
+ let md = Env.find_module path env in
+ accum_aliases md acc
| Mty_ident _ | Mty_signature _ | Mty_functor _ ->
List.rev acc
in
- let path, _ = Typetexp.find_module env loc lid in
- accum_aliases path []
+ let _, md = Env.lookup_module ~loc lid env in
+ accum_aliases md []
)
"Print the signature of the corresponding module."
let () =
reg_show_prim "show_module_type"
(fun env loc id lid ->
- let _path, desc = Typetexp.find_modtype env loc lid in
+ let _path, desc = Env.lookup_modtype ~loc lid env in
[ Sig_modtype (id, desc, Exported) ]
)
"Print the signature of the corresponding module type."
let () =
reg_show_prim "show_class"
(fun env loc id lid ->
- let _path, desc = Typetexp.find_class env loc lid in
+ let _path, desc = Env.lookup_class ~loc lid env in
[ Sig_class (id, desc, Trec_not, Exported) ]
)
"Print the signature of the corresponding class."
let () =
reg_show_prim "show_class_type"
(fun env loc id lid ->
- let _path, desc = Typetexp.find_class_type env loc lid in
+ let _path, desc = Env.lookup_cltype ~loc lid env in
[ Sig_class_type (id, desc, Trec_not, Exported) ]
)
"Print the signature of the corresponding class type."
doc: string;
}
+(* Phase buffer that stores the last toplevel phrase (see
+ [Location.input_phrase_buffer]). *)
+let phrase_buffer = Buffer.create 1024
+
(* The table of toplevel value bindings and its accessors *)
let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty
[ Ptop_def
[ Str.module_
(Mb.mk
- (Location.mknoloc modname)
+ (Location.mknoloc (Some modname))
(Mod.structure items)
)
]
if !i >= len then raise Exit;
let c = input_char stdin in
Bytes.set buffer !i c;
+ (* Also populate the phrase buffer as new characters are added. *)
+ Buffer.add_char phrase_buffer c;
incr i;
if c = '\n' then raise Exit;
done;
Env.import_crcs ~source:Sys.executable_name crc_intfs;
()
+let find_ocamlinit () =
+ let ocamlinit = ".ocamlinit" in
+ if Sys.file_exists ocamlinit then Some ocamlinit else
+ let getenv var = match Sys.getenv var with
+ | exception Not_found -> None | "" -> None | v -> Some v
+ in
+ let exists_in_dir dir file = match dir with
+ | None -> None
+ | Some dir ->
+ let file = Filename.concat dir file in
+ if Sys.file_exists file then Some file else None
+ in
+ let home_dir () = getenv "HOME" in
+ let config_dir () =
+ if Sys.win32 then None else
+ match getenv "XDG_CONFIG_HOME" with
+ | Some _ as v -> v
+ | None ->
+ match home_dir () with
+ | None -> None
+ | Some dir -> Some (Filename.concat dir ".config")
+ in
+ let init_ml = Filename.concat "ocaml" "init.ml" in
+ match exists_in_dir (config_dir ()) init_ml with
+ | Some _ as v -> v
+ | None -> exists_in_dir (home_dir ()) ocamlinit
+
let load_ocamlinit ppf =
if !Clflags.noinit then ()
else match !Clflags.init_file with
| Some f -> if Sys.file_exists f then ignore (use_silently ppf f)
else fprintf ppf "Init file not found: \"%s\".@." f
| None ->
- if Sys.file_exists ".ocamlinit" then ignore (use_silently ppf ".ocamlinit")
- else try
- let home_init = Filename.concat (Sys.getenv "HOME") ".ocamlinit" in
- if Sys.file_exists home_init then ignore (use_silently ppf home_init)
- with Not_found -> ()
+ match find_ocamlinit () with
+ | None -> ()
+ | Some file -> ignore (use_silently ppf file)
;;
let set_paths () =
Location.init lb "//toplevel//";
Location.input_name := "//toplevel//";
Location.input_lexbuf := Some lb;
+ Location.input_phrase_buffer := Some phrase_buffer;
Sys.catch_break true;
run_hooks After_setup;
load_ocamlinit ppf;
let snap = Btype.snapshot () in
try
Lexing.flush_input lb;
+ (* Reset the phrase buffer when we flush the lexing buffer. *)
+ Buffer.reset phrase_buffer;
Location.reset();
Warnings.reset_fatal ();
first_line := true;
(* *)
(**************************************************************************)
-open Clflags
open Compenv
let usage = "Usage: ocaml <options> <object-files> [script-file [arguments]]\n\
else exit 2
end
-let print_version () =
- Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
- exit 0;
-;;
-
-let print_version_num () =
- Printf.printf "%s\n" Sys.ocaml_version;
- exit 0;
-;;
let wrap_expand f s =
let start = !current in
arr
module Options = Main_args.Make_bytetop_options (struct
- let set r () = r := true
- let clear r () = r := false
-
- let _absname = set Clflags.absname
- let _alert = Warnings.parse_alert_option
- let _I dir = include_dirs := dir :: !include_dirs
- let _init s = init_file := Some s
- let _noinit = set noinit
- let _labels = clear classic
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noprompt = set noprompt
- let _nopromptcont = set nopromptcont
- let _nostdlib = set no_std_include
- let _nopervasives = set nopervasives
- let _open s = open_modules := s :: !open_modules
- let _ppx s = first_ppx := s :: !first_ppx
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _safe_string = clear unsafe_string
- let _short_paths = clear real_paths
- let _stdin () = file_argument ""
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _version () = print_version ()
- let _vnum () = print_version_num ()
- let _no_version = set noversion
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _dflambda = set dump_flambda
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
- let _dinstr = set dump_instr
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
-
- let _args = wrap_expand Arg.read_arg
- let _args0 = wrap_expand Arg.read_arg0
-
- let anonymous s = file_argument s
+ include Main_args.Default.Topmain
+ let _stdin () = file_argument ""
+ let _args = wrap_expand Arg.read_arg
+ let _args0 = wrap_expand Arg.read_arg0
+ let anonymous s = file_argument s
end);;
let () =
Requests, suggest more cleanups, or even start working on specific
tasks (ideally after discussing it first with maintainers).
+# Code smells
+
+- global mutable state
+- poor data representation
+- avoid constructing a parsetree locally
+ (methods build a piece of AST with a self argument
+ with a *-using name to avoid conflicts; #row, etc.)
+- avoid magic string literals
+
+# TODO List
+
Not all ideas have been thoroughly discussed, and there might not be a
consensus for all of them.
(be careful about memory leaks with the naive approach of representing
links with a persistent heap).
+ Modest version of the proposal: have an explicit indirection layer
+ (type_expr Unode.t)
+ for nodes in the union-find structure. Efficiency cost?
+
- Make the logic for record/constructor disambiguation more readable.
+ (Jacques should write a specification, and then we could try
+ to make the implementation easier for others to understand.)
+
- Tidy up destructive substitution.
- Get rid of syntactic encodings (generating Parsetree fragments
magic "internal" names which should be avoided.
- Get rid of -annot.
+ (see Nicolas' PR)
- Consider storing warning settings (+other context) as part of `Env.t`?
- Introduce a notion of syntactic "path-like location" to point to
allow pointing to AST fragments, and use that to implement "unused"
warnings in a less invasive and less imperative way.
+ (See Thomas' PR)
- Deprecate -nolabels, or even get rid of it?
+ (We could even stop supporting unlabeled full applications.
+ First turn on the warning by default.)
- Using e.g. bisect_ppx, monitor coverage of the typechecker
implementation while running the testsuite, and expand the testsuite
and/or kill dead code in the typechecker to increase coverage ratio.
+ (Partially done by Oxana's Outreachy internship.
+ See PR#8874.
+ Ask Florian Angeletti and Sebastien Hinderer about the current state.)
(* Basic operations on core types *)
-open Misc
open Asttypes
open Types
let is_Tconstr = function {desc=Tconstr _} -> true | _ -> false
let dummy_method = "*dummy method*"
-let default_mty = function
- Some mty -> mty
- | None -> Mty_signature []
(**** Definitions for backtracking ****)
| {desc=Tvariant row'} -> row_more row'
| ty -> ty
-let row_fixed row =
+let merge_fixed_explanation fixed1 fixed2 =
+ match fixed1, fixed2 with
+ | Some Univar _ as x, _ | _, (Some Univar _ as x) -> x
+ | Some Fixed_private as x, _ | _, (Some Fixed_private as x) -> x
+ | Some Reified _ as x, _ | _, (Some Reified _ as x) -> x
+ | Some Rigid as x, _ | _, (Some Rigid as x) -> x
+ | None, None -> None
+
+
+let fixed_explanation row =
let row = row_repr row in
- row.row_fixed ||
- match (repr row.row_more).desc with
- Tvar _ | Tnil -> false
- | Tunivar _ | Tconstr _ -> true
- | _ -> assert false
+ match row.row_fixed with
+ | Some _ as x -> x
+ | None ->
+ let more = repr row.row_more in
+ match more.desc with
+ | Tvar _ | Tnil -> None
+ | Tunivar _ -> Some (Univar more)
+ | Tconstr (p,_,_) -> Some (Reified p)
+ | _ -> assert false
+
+let is_fixed row = match row.row_fixed with
+ | None -> false
+ | Some _ -> true
+
+let row_fixed row = fixed_explanation row <> None
+
let static_row row =
let row = row_repr row in
Tvariant row -> fold_row f result row
| Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil ->
begin match
- Misc.may_map (fun (_,l) -> List.fold_left f result l) row.row_name
+ Option.map (fun (_,l) -> List.fold_left f result l) row.row_name
with
| None -> result
| Some result -> result
it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
it_class_declaration: type_iterators -> class_declaration -> unit;
it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
+ it_functor_param: type_iterators -> functor_parameter -> unit;
it_module_type: type_iterators -> module_type -> unit;
it_class_type: type_iterators -> class_type -> unit;
it_type_kind: type_iterators -> type_kind -> unit;
List.iter
(fun cd ->
iter_type_expr_cstr_args f cd.cd_args;
- Misc.may f cd.cd_res
+ Option.iter f cd.cd_res
)
cstrs
| Type_record(lbls, _) ->
it.it_type_expr it vd.val_type
and it_type_declaration it td =
List.iter (it.it_type_expr it) td.type_params;
- may (it.it_type_expr it) td.type_manifest;
+ Option.iter (it.it_type_expr it) td.type_manifest;
it.it_type_kind it td.type_kind
and it_extension_constructor it td =
it.it_path td.ext_type_path;
List.iter (it.it_type_expr it) td.ext_type_params;
iter_type_expr_cstr_args (it.it_type_expr it) td.ext_args;
- may (it.it_type_expr it) td.ext_ret_type
+ Option.iter (it.it_type_expr it) td.ext_ret_type
and it_module_declaration it md =
it.it_module_type it md.md_type
and it_modtype_declaration it mtd =
- may (it.it_module_type it) mtd.mtd_type
+ Option.iter (it.it_module_type it) mtd.mtd_type
and it_class_declaration it cd =
List.iter (it.it_type_expr it) cd.cty_params;
it.it_class_type it cd.cty_type;
- may (it.it_type_expr it) cd.cty_new;
+ Option.iter (it.it_type_expr it) cd.cty_new;
it.it_path cd.cty_path
and it_class_type_declaration it ctd =
List.iter (it.it_type_expr it) ctd.clty_params;
it.it_class_type it ctd.clty_type;
it.it_path ctd.clty_path
+ and it_functor_param it = function
+ | Unit -> ()
+ | Named (_, mt) -> it.it_module_type it mt
and it_module_type it = function
Mty_ident p
| Mty_alias p -> it.it_path p
| Mty_signature sg -> it.it_signature it sg
- | Mty_functor (_, mto, mt) ->
- may (it.it_module_type it) mto;
+ | Mty_functor (p, mt) ->
+ it.it_functor_param it p;
it.it_module_type it mt
and it_class_type it = function
Cty_constr (p, tyl, cty) ->
| Tpackage (p, _, _) ->
it.it_path p
| Tvariant row ->
- may (fun (p,_) -> it.it_path p) (row_repr row).row_name
+ Option.iter (fun (p,_) -> it.it_path p) (row_repr row).row_name
| _ -> ()
and it_path _p = ()
in
{ it_path; it_type_expr = it_do_type_expr; it_do_type_expr;
- it_type_kind; it_class_type; it_module_type;
+ it_type_kind; it_class_type; it_functor_param; it_module_type;
it_signature; it_class_type_declaration; it_class_declaration;
it_modtype_declaration; it_module_declaration; it_extension_constructor;
it_type_declaration; it_value_description; it_signature_item; }
| Rpresent(Some ty) -> Rpresent(Some(f ty))
| Reither(c, tl, m, e) ->
let e = if keep then e else ref None in
- let m = if row.row_fixed then fixed else m in
+ let m = if is_fixed row then fixed else m in
let tl = List.map f tl in
Reither(c, tl, m, e)
| _ -> fi)
row.row_fields in
let name =
- match row.row_name with None -> None
+ match row.row_name with
+ | None -> None
| Some (path, tl) -> Some (path, List.map f tl) in
+ let row_fixed = if fixed then row.row_fixed else None in
{ row_fields = fields; row_more = more;
- row_bound = (); row_fixed = row.row_fixed && fixed;
+ row_bound = (); row_fixed;
row_closed = row.row_closed; row_name = name; }
let rec copy_kind = function
let unmark_extension_constructor ext =
List.iter unmark_type ext.ext_type_params;
iter_type_expr_cstr_args unmark_type ext.ext_args;
- Misc.may unmark_type ext.ext_ret_type
+ Option.iter unmark_type ext.ext_ret_type
let unmark_class_signature sign =
unmark_type sign.csig_self;
| _ -> ()
(* ; assert (check_memorized_abbrevs ()) *)
(* ; check_expans [] ty' *)
+let set_type_desc ty td =
+ if td != ty.desc then begin
+ log_type ty;
+ ty.desc <- td
+ end
let set_level ty level =
if level <> ty.level then begin
if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
val is_Tunivar: type_expr -> bool
val is_Tconstr: type_expr -> bool
val dummy_method: label
-val default_mty: module_type option -> module_type
val repr: type_expr -> type_expr
(* Return the canonical representative of a type. *)
(* Return the canonical representative of a row field *)
val row_more: row_desc -> type_expr
(* Return the extension variable of the row *)
+
+val is_fixed: row_desc -> bool
+(* Return whether the row is directly marked as fixed or not *)
+
val row_fixed: row_desc -> bool
- (* Return whether the row should be treated as fixed or not *)
+(* Return whether the row should be treated as fixed or not.
+ In particular, [is_fixed row] implies [row_fixed row].
+*)
+
+val fixed_explanation: row_desc -> fixed_explanation option
+(* Return the potential explanation for the fixed row *)
+
+val merge_fixed_explanation:
+ fixed_explanation option -> fixed_explanation option
+ -> fixed_explanation option
+(* Merge two explanations for a fixed row *)
+
val static_row: row_desc -> bool
(* Return whether the row is static or not *)
val hash_variant: label -> int
it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
it_class_declaration: type_iterators -> class_declaration -> unit;
it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
+ it_functor_param: type_iterators -> functor_parameter -> unit;
it_module_type: type_iterators -> module_type -> unit;
it_class_type: type_iterators -> class_type -> unit;
it_type_kind: type_iterators -> type_kind -> unit;
val link_type: type_expr -> type_expr -> unit
(* Set the desc field of [t1] to [Tlink t2], logging the old
value if there is an active snapshot *)
+val set_type_desc: type_expr -> type_desc -> unit
+ (* Set directly the desc field, without sharing *)
val set_level: type_expr -> int -> unit
val set_scope: type_expr -> int -> unit
val set_name:
val set_commu: commutable ref -> commutable -> unit
val set_typeset: TypeSet.t ref -> TypeSet.t -> unit
(* Set references, logging the old value *)
-val log_type: type_expr -> unit
- (* Log the old value of a type, before modifying it by hand *)
(**** Forward declarations ****)
val print_raw: (Format.formatter -> type_expr -> unit) ref
| Module_type of Path.t
| Equation of 'a
+ type fixed_row_case =
+ | Cannot_be_closed
+ | Cannot_add_tags of string list
+
type variant =
| No_intersection
| No_tags of position * (Asttypes.label * row_field) list
| Incompatible_types_for of string
+ | Fixed_row of position * fixed_row_case * fixed_explanation
+
type obj =
| Missing_field of position * string
Incompatible_fields { name; diff = swap_diff diff}
| Obj (Missing_field(pos,s)) -> Obj(Missing_field(swap_position pos,s))
| Obj (Abstract_row pos) -> Obj(Abstract_row (swap_position pos))
+ | Variant (Fixed_row(pos,k,f)) -> Variant (Fixed_row(swap_position pos,k,f))
| Variant (No_tags(pos,f)) -> Variant (No_tags(swap_position pos,f))
| x -> x
let swap x = List.map swap_elt x
with Cannot_expand ->
raise Trace.(Unify [escape(Constructor p)])
end
- | Tconstr(_, _ :: _, _) when expand ->
+ | Tconstr(p, (_ :: _ as tl), _) ->
+ let variance =
+ try (Env.find_type p env).type_variance
+ with Not_found -> List.map (fun _ -> Variance.may_inv) tl in
+ let needs_expand =
+ expand ||
+ List.exists2
+ (fun var ty -> var = Variance.null && (repr ty).level > level)
+ variance tl
+ in
begin try
+ if not needs_expand then raise Cannot_expand;
link_type ty (!forward_try_expand_once env ty);
update_level env level expand ty
with Cannot_expand ->
| Tpackage (p, nl, tl) when level < Path.scope p ->
let p' = normalize_package_path env p in
if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
- log_type ty; ty.desc <- Tpackage (p', nl, tl);
+ set_type_desc ty (Tpackage (p', nl, tl));
update_level env level expand ty
| Tobject(_, ({contents=Some(p, _tl)} as nm))
when level < Path.scope p ->
let row = row_repr row in
begin match row.row_name with
| Some (p, _tl) when level < Path.scope p ->
- log_type ty;
- ty.desc <- Tvariant {row with row_name = None}
+ set_type_desc ty (Tvariant {row with row_name = None})
| _ -> ()
end;
set_level ty level;
in
let row =
match repr more' with (* PR#6163 *)
- {desc=Tconstr _} when not row.row_fixed ->
- {row with row_fixed = true}
+ {desc=Tconstr (x,_,_)} when not (is_fixed row) ->
+ {row with row_fixed = Some (Reified x)}
| _ -> row
in
(* Open row if partial for pattern and contains Reither *)
Reither _ -> false
| _ -> true
in
- if row.row_closed && not row.row_fixed
+ if row.row_closed && not (is_fixed row)
&& TypeSet.is_empty (free_univars ty)
&& not (List.for_all not_reither row.row_fields) then
(more',
{row_fields = List.filter not_reither row.row_fields;
row_more = more'; row_bound = ();
- row_closed = false; row_fixed = false; row_name = None})
+ row_closed = false; row_fixed = None; row_name = None})
else (more', row)
| _ -> (more', row)
in
type_expansion_scope = expansion_scope;
type_loc = Location.none;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
(fun c ->
{c with
cd_args = map_type_expr_cstr_args f c.cd_args;
- cd_res = may_map f c.cd_res
+ cd_res = Option.map f c.cd_res
})
cl)
| Type_record (fl, rr) ->
let instance_declaration decl =
For_copy.with_scope (fun scope ->
{decl with type_params = List.map (copy scope) decl.type_params;
- type_manifest = may_map (copy scope) decl.type_manifest;
+ type_manifest = Option.map (copy scope) decl.type_manifest;
type_kind = map_kind (copy scope) decl.type_kind;
}
)
| Tvariant r ->
let r = row_repr r in
if not (static_row r) then begin
- if r.row_fixed then iterator (row_more r) else
+ if is_fixed r then iterator (row_more r) else
let m = r.row_more in
match m.desc with
Tvar o ->
let path, t = create_fresh_constr m.level o in
let row =
- {r with row_fields=[]; row_fixed=true; row_more = t} in
+ let row_fixed = Some (Reified path) in
+ {r with row_fields=[]; row_fixed; row_more = t} in
link_type m (newty2 m.level (Tvariant row));
if m.level < fresh_constr_scope then
raise Trace.(Unify [escape (Constructor path)])
environment. However no operation which cares about levels/scopes is going
to happen while this module exists.
The only operations that happen are:
- - Env.lookup_type
- - Env.find_type
+ - Env.find_type_by_name
- nondep_instance
None of which check the scope.
| n :: nl, (n2, _ as nt2) :: ntl' when n >= n2 ->
nt2 :: complete (if n = n2 then nl else nl1) ntl'
| n :: nl, _ ->
- try
- let path =
- Env.lookup_type (concat_longident (Longident.Lident "Pkg") n) env'
- in
- match Env.find_type path env' with
- {type_arity = 0; type_kind = Type_abstract;
- type_private = Public; type_manifest = Some t2} ->
- (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2
- | {type_arity = 0; type_kind = Type_abstract;
- type_private = Public; type_manifest = None} when allow_absent ->
- complete nl ntl2
- | _ -> raise Exit
- with
- | Not_found when allow_absent -> complete nl ntl2
- | Exit -> raise Not_found
+ let lid = concat_longident (Longident.Lident "Pkg") n in
+ match Env.find_type_by_name lid env' with
+ | (_, {type_arity = 0; type_kind = Type_abstract;
+ type_private = Public; type_manifest = Some t2}) ->
+ (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2
+ | (_, {type_arity = 0; type_kind = Type_abstract;
+ type_private = Public; type_manifest = None})
+ when allow_absent ->
+ complete nl ntl2
+ | _ -> raise Exit
+ | exception Not_found when allow_absent->
+ complete nl ntl2
in
- complete nl1 (List.combine nl2 tl2)
+ match complete nl1 (List.combine nl2 tl2) with
+ | res -> res
+ | exception Exit -> raise Not_found
(* raise Not_found rather than Unify if the module types are incompatible *)
let unify_package env unify_list lv1 p1 n1 tl1 lv2 p2 n2 tl2 =
and make_rowvar level use1 rest1 use2 rest2 =
let set_name ty name =
match ty.desc with
- Tvar None -> log_type ty; ty.desc <- Tvar name
+ Tvar None -> set_type_desc ty (Tvar name)
| _ -> ()
in
let name =
)
pairs
with exn ->
- log_type rest1; rest1.desc <- d1;
- log_type rest2; rest2.desc <- d2;
+ set_type_desc rest1 d1;
+ set_type_desc rest2 d2;
raise exn
and unify_kind k1 k2 =
with Not_found -> ())
r2
end;
- let fixed1 = row_fixed row1 and fixed2 = row_fixed row2 in
- let more =
- if fixed1 then rm1 else
- if fixed2 then rm2 else
- newty2 (min rm1.level rm2.level) (Tvar None) in
- let fixed = fixed1 || fixed2
+ let fixed1 = fixed_explanation row1 and fixed2 = fixed_explanation row2 in
+ let more = match fixed1, fixed2 with
+ | Some _, _ -> rm1
+ | None, Some _ -> rm2
+ | None, None -> newty2 (min rm1.level rm2.level) (Tvar None)
+ in
+ let fixed = merge_fixed_explanation fixed1 fixed2
and closed = row1.row_closed || row2.row_closed in
let keep switch =
List.for_all
if closed then
filter_row_fields row.row_closed rest
else rest in
- if rest <> [] && (row.row_closed || row_fixed row)
- || closed && row_fixed row && not row.row_closed then begin
- let pos = if row == row1 then Trace.First else Trace.Second in
- raise Trace.(Unify [Variant (No_tags(pos,rest))])
+ begin match fixed_explanation row with
+ | None ->
+ if rest <> [] && row.row_closed then
+ let pos = if row == row1 then Trace.First else Trace.Second in
+ raise Trace.(Unify [Variant (No_tags(pos,rest))])
+ | Some fixed ->
+ let pos = if row == row1 then Trace.First else Trace.Second in
+ if closed && not row.row_closed then
+ raise Trace.(Unify [Variant(Fixed_row(pos,Cannot_be_closed,fixed))])
+ else if rest <> [] then
+ let case = Trace.Cannot_add_tags (List.map fst rest) in
+ raise Trace.(Unify [Variant(Fixed_row(pos,case,fixed))])
end;
(* The following test is not principal... should rather use Tnil *)
let rm = row_more row in
if is_Tvar rm then link_type rm (newty2 rm.level Tnil)
end
with exn ->
- log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn
+ set_type_desc rm1 md1; set_type_desc rm2 md2; raise exn
end
and unify_row_field env fixed1 fixed2 more l f1 f2 =
let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
+ let if_not_fixed (pos,fixed) f =
+ match fixed with
+ | None -> f ()
+ | Some fix ->
+ let tr = Trace.[ Variant (Fixed_row (pos,Cannot_add_tags [l],fix)) ] in
+ raise (Unify tr) in
+ let first = Trace.First, fixed1 and second = Trace.Second, fixed2 in
+ let either_fixed = match fixed1, fixed2 with
+ | None, None -> false
+ | _ -> true in
if f1 == f2 then () else
match f1, f2 with
Rpresent(Some t1), Rpresent(Some t2) -> unify env t1 t2
| Rpresent None, Rpresent None -> ()
| Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) ->
if e1 == e2 then () else
- if (fixed1 || fixed2) && not (c1 || c2)
+ if either_fixed && not (c1 || c2)
&& List.length tl1 = List.length tl2 then begin
(* PR#7496 *)
let f = Reither (c1 || c2, [], m1 || m2, ref None) in
end
else let redo =
not !passive_variants &&
- (m1 || m2 || fixed1 || fixed2 ||
+ (m1 || m2 || either_fixed ||
!rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
begin match tl1 @ tl2 with [] -> false
| t1 :: tl ->
let f1' = Reither(c1 || c2, tl1', m1 || m2, e)
and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in
set_row_field e1 f1'; set_row_field e2 f2';
- | Reither(_, _, false, e1), Rabsent when not fixed1 -> set_row_field e1 f2
- | Rabsent, Reither(_, _, false, e2) when not fixed2 -> set_row_field e2 f1
+ | Reither(_, _, false, e1), Rabsent ->
+ if_not_fixed first (fun () -> set_row_field e1 f2)
+ | Rabsent, Reither(_, _, false, e2) ->
+ if_not_fixed second (fun () -> set_row_field e2 f1)
| Rabsent, Rabsent -> ()
- | Reither(false, tl, _, e1), Rpresent(Some t2) when not fixed1 ->
- set_row_field e1 f2;
- let rm = repr more in
- update_level !env rm.level t2;
- update_scope rm.scope t2;
- (try List.iter (fun t1 -> unify env t1 t2) tl
- with exn -> e1 := None; raise exn)
- | Rpresent(Some t1), Reither(false, tl, _, e2) when not fixed2 ->
- set_row_field e2 f1;
- let rm = repr more in
- update_level !env rm.level t1;
- update_scope rm.scope t1;
- (try List.iter (unify env t1) tl
- with exn -> e2 := None; raise exn)
- | Reither(true, [], _, e1), Rpresent None when not fixed1 ->
- set_row_field e1 f2
- | Rpresent None, Reither(true, [], _, e2) when not fixed2 ->
- set_row_field e2 f1
+ | Reither(false, tl, _, e1), Rpresent(Some t2) ->
+ if_not_fixed first (fun () ->
+ set_row_field e1 f2;
+ let rm = repr more in
+ update_level !env rm.level t2;
+ update_scope rm.scope t2;
+ (try List.iter (fun t1 -> unify env t1 t2) tl
+ with exn -> e1 := None; raise exn)
+ )
+ | Rpresent(Some t1), Reither(false, tl, _, e2) ->
+ if_not_fixed second (fun () ->
+ set_row_field e2 f1;
+ let rm = repr more in
+ update_level !env rm.level t1;
+ update_scope rm.scope t1;
+ (try List.iter (unify env t1) tl
+ with exn -> e2 := None; raise exn)
+ )
+ | Reither(true, [], _, e1), Rpresent None ->
+ if_not_fixed first (fun () -> set_row_field e1 f2)
+ | Rpresent None, Reither(true, [], _, e2) ->
+ if_not_fixed second (fun () -> set_row_field e2 f1)
| _ -> raise (Unify [])
let more = repr row.row_more in
if is_Tvar more && not (row_fixed row) then begin
let more' = newty2 more.level more.desc in
- let row' = {row with row_fixed=true; row_fields=[]; row_more=more'}
+ let row' =
+ {row with row_fixed=Some Rigid; row_fields=[]; row_more=more'}
in link_type more (newty2 ty.level (Tvariant row'))
end;
iter_row (rigidify_rec vars) row;
let memq_warn t visited =
if List.memq t visited then (warn := true; true) else false
-let rec lid_of_path ?(hash="") = function
- Path.Pident id ->
- Longident.Lident (hash ^ Ident.name id)
- | Path.Pdot (p1, s) ->
- Longident.Ldot (lid_of_path p1, hash ^ s)
- | Path.Papply (p1, p2) ->
- Longident.Lapply (lid_of_path ~hash p1, lid_of_path p2)
-
let find_cltype_for_path env p =
- let cl_path = Env.lookup_type (lid_of_path ~hash:"#" p) env in
- let cl_abbr = Env.find_type cl_path env in
-
+ let cl_abbr = Env.find_hash_type p env in
match cl_abbr.type_manifest with
Some ty ->
begin match (repr ty).desc with
let c = collect fields in
let row =
{ row_fields = List.map fst fields; row_more = newvar();
- row_bound = (); row_closed = posi; row_fixed = false;
+ row_bound = (); row_closed = posi; row_fixed = None;
row_name = if c > Unchanged then None else row.row_name }
in
(newty (Tvariant row), Changed)
match tm.desc with (* PR#7348 *)
Tconstr (Path.Pdot(m,i), tl, _abbrev) ->
let i' = String.sub i 0 (String.length i - 4) in
- log_type ty;
- ty.desc <- Tconstr(Path.Pdot(m,i'), tl, ref Mnil)
+ set_type_desc ty (Tconstr(Path.Pdot(m,i'), tl, ref Mnil))
| _ -> assert false
else match ty.desc with
| Tvariant row ->
let fields =
List.sort (fun (p,_) (q,_) -> compare p q)
(List.filter (fun (_,fi) -> fi <> Rabsent) fields) in
- log_type ty;
- ty.desc <- Tvariant {row with row_fields = fields}
+ set_type_desc ty (Tvariant {row with row_fields = fields})
| Tobject (fi, nm) ->
begin match !nm with
| None -> ()
| Tvar _ | Tunivar _ ->
if v' != v then set_name nm (Some (n, v' :: l))
| Tnil ->
- log_type ty; ty.desc <- Tconstr (n, l, ref Mnil)
+ set_type_desc ty (Tconstr (n, l, ref Mnil))
| _ -> set_name nm None
end
| _ ->
if fi.level < lowest_level then () else
let fields, row = flatten_fields fi in
let fi' = build_fields fi.level fields row in
- log_type ty; fi.desc <- fi'.desc
+ set_type_desc fi fi'.desc
| _ -> ()
end;
iter_type_expr (normalize_type_rec env visited) ty
ext.ext_type_path, type_params
in
let args = map_type_expr_cstr_args (nondep_type_rec env ids) ext.ext_args in
- let ret_type = may_map (nondep_type_rec env ids) ext.ext_ret_type in
+ let ret_type = Option.map (nondep_type_rec env ids) ext.ext_ret_type in
clear_hash ();
{ ext_type_path = type_path;
ext_type_params = type_params;
let () =
Env.same_constr := same_constr
-let maybe_pointer_type env typ =
+let is_immediate = function
+ | Type_immediacy.Unknown -> false
+ | Type_immediacy.Always -> true
+ | Type_immediacy.Always_on_64bits ->
+ (* In bytecode, we don't know at compile time whether we are
+ targeting 32 or 64 bits. *)
+ !Clflags.native_code && Sys.word_size = 64
+
+let immediacy env typ =
match (repr typ).desc with
| Tconstr(p, _args, _abbrev) ->
begin try
let type_decl = Env.find_type p env in
- not type_decl.type_immediate
- with Not_found -> true
+ type_decl.type_immediate
+ with Not_found -> Type_immediacy.Unknown
(* This can happen due to e.g. missing -I options,
causing some .cmi files to be unavailable.
Maybe we should emit a warning. *)
| Tvariant row ->
let row = Btype.row_repr row in
(* if all labels are devoid of arguments, not a pointer *)
- not row.row_closed
- || List.exists
+ if
+ not row.row_closed
+ || List.exists
(function
| _, (Rpresent (Some _) | Reither (false, _, _, _)) -> true
| _ -> false)
row.row_fields
- | _ -> true
+ then
+ Type_immediacy.Unknown
+ else
+ Type_immediacy.Always
+ | _ -> Type_immediacy.Unknown
+
+let maybe_pointer_type env typ = not (is_immediate (immediacy env typ))
| Equation of 'a
(** Errors for polymorphic variants *)
+
+ type fixed_row_case =
+ | Cannot_be_closed
+ | Cannot_add_tags of string list
+
type variant =
| No_intersection
| No_tags of position * (Asttypes.label * row_field) list
| Incompatible_types_for of string
+ | Fixed_row of position * fixed_row_case * fixed_explanation
+ (** Fixed row types, e.g. ['a. [> `X] as 'a] *)
type obj =
| Missing_field of position * string
val remove_object_name: type_expr -> unit
val hide_private_methods: type_expr -> unit
val find_cltype_for_path: Env.t -> Path.t -> type_declaration * type_expr
-val lid_of_path: ?hash:string -> Path.t -> Longident.t
val sort_row_fields: (label * row_field) list -> (label * row_field) list
val merge_row_fields:
val wrap_trace_gadt_instances: Env.t -> ('a -> 'b) -> 'a -> 'b
val reset_reified_var_counter: unit -> unit
+val immediacy : Env.t -> type_expr -> Type_immediacy.t
+
val maybe_pointer_type : Env.t -> type_expr -> bool
(* True if type is possibly pointer, false if definitely not a pointer *)
type_expansion_scope = Btype.lowest_level;
type_loc = Location.none;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed;
}
in
mutable cu_pattern: bool;
mutable cu_privatize: bool;
}
-let add_constructor_usage cu = function
- | Positive -> cu.cu_positive <- true
- | Pattern -> cu.cu_pattern <- true
- | Privatize -> cu.cu_privatize <- true
+let add_constructor_usage priv cu usage =
+ match priv with
+ | Asttypes.Private -> cu.cu_positive <- true
+ | Asttypes.Public -> begin
+ match usage with
+ | Positive -> cu.cu_positive <- true
+ | Pattern -> cu.cu_pattern <- true
+ | Privatize -> cu.cu_privatize <- true
+ end
+
let constructor_usages () =
{cu_positive = false; cu_pattern = false; cu_privatize = false}
(string * Location.t * string, (constructor_usage -> unit)) Hashtbl.t
= Hashtbl.create 16
-type error =
- | Missing_module of Location.t * Path.t * Path.t
- | Illegal_value_name of Location.t * string
-
-exception Error of error
-
-let error err = raise (Error err)
-
(** Map indexed by the name of module components. *)
module NameMap = String.Map
+type value_unbound_reason =
+ | Val_unbound_instance_variable
+ | Val_unbound_self
+ | Val_unbound_ancestor
+ | Val_unbound_ghost_recursive of Location.t
+
+type module_unbound_reason =
+ | Mod_unbound_illegal_recursion
+
type summary =
Env_empty
| Env_value of summary * Ident.t * value_description
| Env_open of summary * Path.t
| Env_functor_arg of summary * Ident.t
| Env_constraints of summary * type_declaration Path.Map.t
- | Env_copy_types of summary * string list
+ | Env_copy_types of summary
| Env_persistent of summary * Ident.t
+ | Env_value_unbound of summary * string * value_unbound_reason
+ | Env_module_unbound of summary * string * module_unbound_reason
type address =
| Aident of Ident.t
let nothing = fun () -> ()
- let mk_callback rest name desc = function
+ let mk_callback rest name desc using =
+ match using with
| None -> nothing
| Some f ->
(fun () ->
match rest with
| [] -> f name None
- | (hidden, _) :: _ -> f name (Some (desc, hidden))
- )
+ | (hidden, _) :: _ -> f name (Some (desc, hidden)))
- let rec find_all name tbl =
+ let rec find_all ~mark name tbl =
List.map (fun (_id, desc) -> desc, nothing)
(Ident.find_all name tbl.current) @
match tbl.opened with
| None -> []
| Some {using; next; components} ->
- let rest = find_all name next in
+ let rest = find_all ~mark name next in
+ let using = if mark then using else None in
match NameMap.find name components with
| exception Not_found -> rest
| opened ->
bindings between each of them. *)
- type 'a t = {
+ type ('a, 'b) t = {
current: 'a Ident.tbl;
(** Local bindings since the last open *)
- opened: 'a opened option;
+ layer: ('a, 'b) layer;
(** Symbolic representation of the last (innermost) open, if any. *)
}
- and 'a opened = {
- root: Path.t;
- (** The path of the opened module, to be prefixed in front of
- its local names to produce a valid path in the current
- environment. *)
+ and ('a, 'b) layer =
+ | Open of {
+ root: Path.t;
+ (** The path of the opened module, to be prefixed in front of
+ its local names to produce a valid path in the current
+ environment. *)
- components: 'a NameMap.t;
- (** Components from the opened module. *)
+ components: 'b NameMap.t;
+ (** Components from the opened module. *)
- using: (string -> ('a * 'a) option -> unit) option;
- (** A callback to be applied when a component is used from this
- "open". This is used to detect unused "opens". The
- arguments are used to detect shadowing. *)
+ using: (string -> ('a * 'a) option -> unit) option;
+ (** A callback to be applied when a component is used from this
+ "open". This is used to detect unused "opens". The
+ arguments are used to detect shadowing. *)
- next: 'a t;
- (** The table before opening the module. *)
- }
+ next: ('a, 'b) t;
+ (** The table before opening the module. *)
+ }
- let empty = { current = Ident.empty; opened = None }
+ | Map of {
+ f: ('a -> 'a);
+ next: ('a, 'b) t;
+ }
+
+ | Nothing
+
+ let empty = { current = Ident.empty; layer = Nothing }
let add id x tbl =
{tbl with current = Ident.add id x tbl.current}
in
{
current = Ident.empty;
- opened = Some {using; root; components; next};
+ layer = Open {using; root; components; next};
+ }
+
+ let map f next =
+ {
+ current = Ident.empty;
+ layer = Map {f; next}
}
let rec find_same id tbl =
try Ident.find_same id tbl.current
with Not_found as exn ->
- begin match tbl.opened with
- | Some {next; _} -> find_same id next
- | None -> raise exn
+ begin match tbl.layer with
+ | Open {next; _} -> find_same id next
+ | Map {f; next} -> f (find_same id next)
+ | Nothing -> raise exn
end
- let rec find_name ~mark name tbl =
+ let rec find_name wrap ~mark name tbl =
try
let (id, desc) = Ident.find_name name tbl.current in
Pident id, desc
with Not_found as exn ->
- begin match tbl.opened with
- | Some {using; root; next; components} ->
+ begin match tbl.layer with
+ | Open {using; root; next; components} ->
begin try
- let descr = NameMap.find name components in
+ let descr = wrap (NameMap.find name components) in
let res = Pdot (root, name), descr in
if mark then begin match using with
| None -> ()
| Some f -> begin
- match find_name ~mark:false name next with
+ match find_name wrap ~mark:false name next with
| exception Not_found -> f name None
| _, descr' -> f name (Some (descr', descr))
end
end;
res
with Not_found ->
- find_name ~mark name next
+ find_name wrap ~mark name next
end
- | None ->
+ | Map {f; next} ->
+ let (p, desc) = find_name wrap ~mark name next in
+ p, f desc
+ | Nothing ->
raise exn
end
- let rec update name f tbl =
- try
- let (id, desc) = Ident.find_name name tbl.current in
- let new_desc = f desc in
- {tbl with current = Ident.add id new_desc tbl.current}
- with Not_found ->
- begin match tbl.opened with
- | Some {root; using; next; components} ->
- begin try
- let desc = NameMap.find name components in
- let new_desc = f desc in
- let components = NameMap.add name new_desc components in
- {tbl with opened = Some {root; using; next; components}}
- with Not_found ->
- let next = update name f next in
- {tbl with opened = Some {root; using; next; components}}
- end
- | None ->
- tbl
- end
-
-
-
- let rec find_all name tbl =
+ let rec find_all wrap name tbl =
List.map
(fun (id, desc) -> Pident id, desc)
(Ident.find_all name tbl.current) @
- match tbl.opened with
- | None -> []
- | Some {root; using = _; next; components} ->
- try
- let desc = NameMap.find name components in
- (Pdot (root, name), desc) :: find_all name next
+ match tbl.layer with
+ | Nothing -> []
+ | Open {root; using = _; next; components} ->
+ begin try
+ let desc = wrap (NameMap.find name components) in
+ (Pdot (root, name), desc) :: find_all wrap name next
with Not_found ->
- find_all name next
+ find_all wrap name next
+ end
+ | Map {f; next} ->
+ List.map (fun (p, desc) -> (p, f desc))
+ (find_all wrap name next)
- let rec fold_name f tbl acc =
+ let rec fold_name wrap f tbl acc =
let acc =
Ident.fold_name
(fun id d -> f (Ident.name id) (Pident id, d))
tbl.current acc
in
- match tbl.opened with
- | Some {root; using = _; next; components} ->
+ match tbl.layer with
+ | Open {root; using = _; next; components} ->
acc
|> NameMap.fold
- (fun name desc -> f name (Pdot (root, name), desc))
+ (fun name desc -> f name (Pdot (root, name), wrap desc))
components
- |> fold_name f next
- | None ->
+ |> fold_name wrap f next
+ | Nothing ->
acc
+ | Map {f=g; next} ->
+ acc
+ |> fold_name wrap
+ (fun name (path, desc) -> f name (path, g desc))
+ next
let rec local_keys tbl acc =
let acc = Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc in
- match tbl.opened with
- | Some o -> local_keys o.next acc
- | None -> acc
+ match tbl.layer with
+ | Open {next; _ } | Map {next; _} -> local_keys next acc
+ | Nothing -> acc
- let rec iter f tbl =
+ let rec iter wrap f tbl =
Ident.iter (fun id desc -> f id (Pident id, desc)) tbl.current;
- match tbl.opened with
- | Some {root; using = _; next; components} ->
+ match tbl.layer with
+ | Open {root; using = _; next; components} ->
NameMap.iter
(fun s x ->
let root_scope = Path.scope root in
f (Ident.create_scoped ~scope:root_scope s)
- (Pdot (root, s), x))
+ (Pdot (root, s), wrap x))
components;
- iter f next
- | None -> ()
+ iter wrap f next
+ | Map {f=g; next} ->
+ iter wrap (fun id (path, desc) -> f id (path, g desc)) next
+ | Nothing -> ()
let diff_keys tbl1 tbl2 =
let keys2 = local_keys tbl2 [] in
let in_signature_flag = 0x01
-type 'a value_or_persistent =
- | Value of 'a
- | Persistent
-
type t = {
- values: (value_description * address_lazy) IdTbl.t;
- constrs: (constructor_description * address_lazy option) TycompTbl.t;
- labels: label_description TycompTbl.t;
- types: (type_declaration * type_descriptions) IdTbl.t;
- modules: (module_declaration_lazy * address_lazy) value_or_persistent IdTbl.t;
- modtypes: modtype_declaration IdTbl.t;
- components: (module_components * address_lazy) value_or_persistent IdTbl.t;
- classes: (class_declaration * address_lazy) IdTbl.t;
- cltypes: class_type_declaration IdTbl.t;
+ values: (value_entry, value_data) IdTbl.t;
+ constrs: constructor_data TycompTbl.t;
+ labels: label_data TycompTbl.t;
+ types: (type_data, type_data) IdTbl.t;
+ modules: (module_entry, module_data) IdTbl.t;
+ modtypes: (modtype_data, modtype_data) IdTbl.t;
+ classes: (class_data, class_data) IdTbl.t;
+ cltypes: (cltype_data, cltype_data) IdTbl.t;
functor_args: unit Ident.tbl;
summary: summary;
local_constraints: type_declaration Path.Map.t;
{
alerts: alerts;
loc: Location.t;
- comps: (components_maker, module_components_repr option) EnvLazy.t;
+ comps:
+ (components_maker,
+ (module_components_repr, module_components_failure) result)
+ EnvLazy.t;
}
and components_maker = {
Structure_comps of structure_components
| Functor_comps of functor_components
+and module_components_failure =
+ | No_components_abstract
+ | No_components_alias of Path.t
+
and structure_components = {
- mutable comp_values: (value_description * address_lazy) NameMap.t;
- mutable comp_constrs:
- ((constructor_description * address_lazy option) list) NameMap.t;
- mutable comp_labels: label_description list NameMap.t;
- mutable comp_types: (type_declaration * type_descriptions) NameMap.t;
- mutable comp_modules: (module_declaration_lazy * address_lazy) NameMap.t;
- mutable comp_modtypes: modtype_declaration NameMap.t;
- mutable comp_components: (module_components * address_lazy) NameMap.t;
- mutable comp_classes: (class_declaration * address_lazy) NameMap.t;
- mutable comp_cltypes: class_type_declaration NameMap.t;
+ mutable comp_values: value_data NameMap.t;
+ mutable comp_constrs: constructor_data list NameMap.t;
+ mutable comp_labels: label_data list NameMap.t;
+ mutable comp_types: type_data NameMap.t;
+ mutable comp_modules: module_data NameMap.t;
+ mutable comp_modtypes: modtype_data NameMap.t;
+ mutable comp_classes: class_data NameMap.t;
+ mutable comp_cltypes: cltype_data NameMap.t;
}
and functor_components = {
- fcomp_param: Ident.t; (* Formal parameter *)
- fcomp_arg: module_type option; (* Argument signature *)
+ fcomp_arg: functor_parameter;
+ (* Formal parameter and argument signature *)
fcomp_res: module_type; (* Result signature *)
fcomp_cache: (Path.t, module_components) Hashtbl.t; (* For memoization *)
fcomp_subst_cache: (Path.t, module_type) Hashtbl.t
and address_lazy = (address_unforced, address) EnvLazy.t
+and value_data =
+ { vda_description : value_description;
+ vda_address : address_lazy }
+
+and value_entry =
+ | Val_bound of value_data
+ | Val_unbound of value_unbound_reason
+
+and constructor_data =
+ { cda_description : constructor_description;
+ cda_address : address_lazy option; }
+
+and label_data = label_description
+
+and type_data =
+ { tda_declaration : type_declaration;
+ tda_descriptions : type_descriptions; }
+
+and module_data =
+ { mda_declaration : module_declaration_lazy;
+ mda_components : module_components;
+ mda_address : address_lazy; }
+
+and module_entry =
+ | Mod_local of module_data
+ | Mod_persistent
+ | Mod_unbound of module_unbound_reason
+
+and modtype_data = modtype_declaration
+
+and class_data =
+ { clda_declaration : class_declaration;
+ clda_address : address_lazy }
+
+and cltype_data = class_type_declaration
+
let empty_structure =
Structure_comps {
comp_values = NameMap.empty;
comp_labels = NameMap.empty;
comp_types = NameMap.empty;
comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
- comp_components = NameMap.empty; comp_classes = NameMap.empty;
+ comp_classes = NameMap.empty;
comp_cltypes = NameMap.empty }
+type unbound_value_hint =
+ | No_hint
+ | Missing_rec of Location.t
+
+type lookup_error =
+ | Unbound_value of Longident.t * unbound_value_hint
+ | Unbound_type of Longident.t
+ | Unbound_constructor of Longident.t
+ | Unbound_label of Longident.t
+ | Unbound_module of Longident.t
+ | Unbound_class of Longident.t
+ | Unbound_modtype of Longident.t
+ | Unbound_cltype of Longident.t
+ | Unbound_instance_variable of string
+ | Not_an_instance_variable of string
+ | Masked_instance_variable of Longident.t
+ | Masked_self_variable of Longident.t
+ | Masked_ancestor_variable of Longident.t
+ | Structure_used_as_functor of Longident.t
+ | Abstract_used_as_functor of Longident.t
+ | Functor_used_as_structure of Longident.t
+ | Abstract_used_as_structure of Longident.t
+ | Generative_used_as_applicative of Longident.t
+ | Illegal_reference_to_recursive_module
+ | Cannot_scrape_alias of Longident.t * Path.t
+
+type error =
+ | Missing_module of Location.t * Path.t * Path.t
+ | Illegal_value_name of Location.t * string
+ | Lookup_error of Location.t * t * lookup_error
+
+exception Error of error
+
+let error err = raise (Error err)
+
+let lookup_error loc env err =
+ error (Lookup_error(loc, env, err))
+
let copy_local ~from env =
{ env with
local_constraints = from.local_constraints;
type declarations to silence the shadowing warnings. *)
let check_shadowing env = function
- | `Constructor (Some ((c1, _), (c2, _)))
- when not (!same_constr env c1.cstr_res c2.cstr_res) ->
+ | `Constructor (Some (cda1, cda2))
+ when not (!same_constr env
+ cda1.cda_description.cstr_res
+ cda2.cda_description.cstr_res) ->
Some "constructor"
| `Label (Some (l1, l2))
when not (!same_constr env l1.lbl_res l2.lbl_res) ->
values = IdTbl.empty; constrs = TycompTbl.empty;
labels = TycompTbl.empty; types = IdTbl.empty;
modules = IdTbl.empty; modtypes = IdTbl.empty;
- components = IdTbl.empty; classes = IdTbl.empty;
- cltypes = IdTbl.empty;
+ classes = IdTbl.empty; cltypes = IdTbl.empty;
summary = Env_empty; local_constraints = Path.Map.empty;
flags = 0;
functor_args = Ident.empty;
let is_in_signature env = env.flags land in_signature_flag <> 0
+let has_local_constraints env =
+ not (Path.Map.is_empty env.local_constraints)
+
let is_ident = function
Pident _ -> true
| Pdot _ | Papply _ -> false
-let is_local_ext = function
- | {cstr_tag = Cstr_extension(p, _)}, _ -> is_ident p
+let is_ext cda =
+ match cda.cda_description with
+ | {cstr_tag = Cstr_extension _} -> true
+ | _ -> false
+
+let is_local_ext cda =
+ match cda.cda_description with
+ | {cstr_tag = Cstr_extension(p, _)} -> is_ident p
| _ -> false
let diff env1 env2 =
IdTbl.diff_keys env1.modules env2.modules @
IdTbl.diff_keys env1.classes env2.classes
+(* Functions for use in "wrap" parameters in IdTbl *)
+let wrap_identity x = x
+let wrap_value vda = Val_bound vda
+let wrap_module mda = Mod_local mda
+
(* Forward declarations *)
-let components_of_module' =
- ref ((fun ~alerts:_ ~loc:_ _env _fsub _psub _path _addr _mty -> assert false):
- alerts:alerts -> loc:Location.t -> t ->
- Subst.t option -> Subst.t -> Path.t -> address_lazy -> module_type ->
- module_components)
let components_of_module_maker' =
ref ((fun _ -> assert false) :
- components_maker -> module_components_repr option)
+ components_maker ->
+ (module_components_repr, module_components_failure) result)
+
let components_of_functor_appl' =
- ref ((fun _f _env _p1 _p2 -> assert false) :
- functor_components -> t -> Path.t -> Path.t -> module_components)
-let check_modtype_inclusion =
- (* to be filled with Includemod.check_modtype_inclusion *)
- ref ((fun ~loc:_ _env _mty1 _path1 _mty2 -> assert false) :
- loc:Location.t -> t -> module_type -> Path.t -> module_type -> unit)
+ ref ((fun ~loc:_ _f _env _p1 _p2 -> assert false) :
+ loc:Location.t -> functor_components -> t ->
+ Path.t -> Path.t -> module_components)
+let check_functor_application =
+ (* to be filled by Includemod *)
+ ref ((fun ~errors:_ ~loc:_ _env _mty1 _path1 _mty2 _path2 -> assert false) :
+ errors:bool -> loc:Location.t -> t -> module_type ->
+ Path.t -> module_type -> Path.t -> unit)
let strengthen =
(* to be filled with Mtype.strengthen *)
ref ((fun ~aliasable:_ _env _mty _path -> assert false) :
| x -> x
| exception Not_found
when Ident.persistent id && not (Current_unit_name.is_name_of id) ->
- Persistent
+ Mod_persistent
-(* signature of persistent compilation units *)
-type persistent_module = {
- pm_signature: signature Lazy.t;
- pm_components: module_components;
-}
+let find_name_module ~mark name tbl =
+ match IdTbl.find_name wrap_module ~mark name tbl with
+ | x -> x
+ | exception Not_found when not (Current_unit_name.is name) ->
+ let path = Pident(Ident.create_persistent name) in
+ path, Mod_persistent
let add_persistent_structure id env =
if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure";
if not (Current_unit_name.is_name_of id) then
{ env with
- modules = IdTbl.add id Persistent env.modules;
- components = IdTbl.add id Persistent env.components;
+ modules = IdTbl.add id Mod_persistent env.modules;
summary = Env_persistent (env.summary, id);
}
else
env
+let components_of_module ~alerts ~loc env fs ps path addr mty =
+ {
+ alerts;
+ loc;
+ comps = EnvLazy.create {
+ cm_env = env;
+ cm_freshening_subst = fs;
+ cm_prefixing_subst = ps;
+ cm_path = path;
+ cm_addr = addr;
+ cm_mty = mty
+ }
+ }
+
let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
let name = cmi.cmi_name in
let sign = cmi.cmi_sign in
let flags = cmi.cmi_flags in
let id = Ident.create_persistent name in
let path = Pident id in
- let addr = EnvLazy.create_forced (Aident id) in
let alerts =
List.fold_left (fun acc -> function Alerts s -> s | _ -> acc)
Misc.Stdlib.String.Map.empty
flags
in
let loc = Location.none in
- let pm_signature = lazy (Subst.signature Make_local Subst.identity sign) in
- let pm_components =
+ let md = md (Mty_signature sign) in
+ let mda_address = EnvLazy.create_forced (Aident id) in
+ let mda_declaration =
+ EnvLazy.create (Subst.identity, Subst.Make_local, md)
+ in
+ let mda_components =
let freshening_subst =
- if freshen then (Some Subst.identity) else None in
- !components_of_module' ~alerts ~loc
- empty freshening_subst Subst.identity path addr (Mty_signature sign) in
+ if freshen then (Some Subst.identity) else None
+ in
+ components_of_module ~alerts ~loc
+ empty freshening_subst Subst.identity
+ path mda_address (Mty_signature sign)
+ in
{
- pm_signature;
- pm_components;
+ mda_declaration;
+ mda_components;
+ mda_address;
}
let read_sign_of_cmi = sign_of_cmi ~freshen:true
let save_sign_of_cmi = sign_of_cmi ~freshen:false
-let persistent_env : persistent_module Persistent_env.t =
+let persistent_env : module_data Persistent_env.t =
Persistent_env.empty ()
let without_cmis f x =
(* get_components *)
-let get_components_opt c =
+let get_components_res c =
match Persistent_env.can_load_cmis persistent_env with
| Persistent_env.Can_load_cmis ->
EnvLazy.force !components_of_module_maker' c.comps
EnvLazy.force_logged log !components_of_module_maker' c.comps
let get_components c =
- match get_components_opt c with
- | None -> empty_structure
- | Some c -> c
+ match get_components_res c with
+ | Error _ -> empty_structure
+ | Ok c -> c
+
+(* Module type of functor application *)
+
+let modtype_of_functor_appl fcomp p1 p2 =
+ match fcomp.fcomp_res with
+ | Mty_alias _ as mty -> mty
+ | mty ->
+ try
+ Hashtbl.find fcomp.fcomp_subst_cache p2
+ with Not_found ->
+ let scope = Path.scope (Papply(p1, p2)) in
+ let mty =
+ let subst =
+ match fcomp.fcomp_arg with
+ | Unit
+ | Named (None, _) -> Subst.identity
+ | Named (Some param, _) -> Subst.add_module param p2 Subst.identity
+ in
+ Subst.modtype (Rescope scope) subst mty
+ in
+ Hashtbl.add fcomp.fcomp_subst_cache p2 mty;
+ mty
(* Lookup by identifier *)
-let rec find_module_descr path env =
+let find_ident_module id env =
+ match find_same_module id env.modules with
+ | Mod_local data -> data
+ | Mod_unbound _ -> raise Not_found
+ | Mod_persistent -> find_pers_mod (Ident.name id)
+
+let rec find_module_components path env =
match path with
- Pident id ->
- begin match find_same_module id env.components with
- | Value x -> fst x
- | Persistent -> (find_pers_mod (Ident.name id)).pm_components
- end
+ | Pident id -> (find_ident_module id env).mda_components
| Pdot(p, s) ->
- begin match get_components (find_module_descr p env) with
- Structure_comps c ->
- fst (NameMap.find s c.comp_components)
- | Functor_comps _ ->
- raise Not_found
- end
+ let sc = find_structure_components p env in
+ (NameMap.find s sc.comp_modules).mda_components
| Papply(p1, p2) ->
- begin match get_components (find_module_descr p1 env) with
- Functor_comps f ->
- !components_of_functor_appl' f env p1 p2
- | Structure_comps _ ->
- raise Not_found
- end
+ let fc = find_functor_components p1 env in
+ let loc = Location.(in_file !input_name) in
+ !components_of_functor_appl' ~loc fc env p1 p2
+
+and find_structure_components path env =
+ match get_components (find_module_components path env) with
+ | Structure_comps c -> c
+ | Functor_comps _ -> raise Not_found
+
+and find_functor_components path env =
+ match get_components (find_module_components path env) with
+ | Functor_comps f -> f
+ | Structure_comps _ -> raise Not_found
-let find proj1 proj2 path env =
+let find_module ~alias path env =
match path with
- Pident id -> IdTbl.find_same id (proj1 env)
+ | Pident id ->
+ let data = find_ident_module id env in
+ EnvLazy.force subst_modtype_maker data.mda_declaration
| Pdot(p, s) ->
- begin match get_components (find_module_descr p env) with
- Structure_comps c -> NameMap.find s (proj2 c)
- | Functor_comps _ ->
- raise Not_found
- end
- | Papply _ ->
- raise Not_found
+ let sc = find_structure_components p env in
+ let data = NameMap.find s sc.comp_modules in
+ EnvLazy.force subst_modtype_maker data.mda_declaration
+ | Papply(p1, p2) ->
+ let fc = find_functor_components p1 env in
+ if alias then md (fc.fcomp_res)
+ else md (modtype_of_functor_appl fc p1 p2)
-let find_value_full =
- find (fun env -> env.values) (fun sc -> sc.comp_values)
-and find_type_full =
- find (fun env -> env.types) (fun sc -> sc.comp_types)
-and find_modtype =
- find (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
-and find_class_full =
- find (fun env -> env.classes) (fun sc -> sc.comp_classes)
-and find_cltype =
- find (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
-
-let find_value p env =
- fst (find_value_full p env)
-let find_class p env =
- fst (find_class_full p env)
+let find_value_full path env =
+ match path with
+ | Pident id -> begin
+ match IdTbl.find_same id env.values with
+ | Val_bound data -> data
+ | Val_unbound _ -> raise Not_found
+ end
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_values
+ | Papply _ -> raise Not_found
+
+let find_type_full path env =
+ match path with
+ | Pident id -> IdTbl.find_same id env.types
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_types
+ | Papply _ -> raise Not_found
+
+let find_modtype path env =
+ match path with
+ | Pident id -> IdTbl.find_same id env.modtypes
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_modtypes
+ | Papply _ -> raise Not_found
+
+let find_class_full path env =
+ match path with
+ | Pident id -> IdTbl.find_same id env.classes
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_classes
+ | Papply _ -> raise Not_found
+
+let find_cltype path env =
+ match path with
+ | Pident id -> IdTbl.find_same id env.cltypes
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ NameMap.find s sc.comp_cltypes
+ | Papply _ -> raise Not_found
+
+let find_value path env =
+ (find_value_full path env).vda_description
+
+let find_class path env =
+ (find_class_full path env).clda_declaration
+
+let find_ident_constructor id env =
+ (TycompTbl.find_same id env.constrs).cda_description
+
+let find_ident_label id env =
+ TycompTbl.find_same id env.labels
let type_of_cstr path = function
- | {cstr_inlined = Some d; _} ->
- (d, ([], List.map snd (Datarepr.labels_of_type path d)))
+ | {cstr_inlined = Some decl; _} ->
+ let labels =
+ List.map snd (Datarepr.labels_of_type path decl)
+ in
+ { tda_declaration = decl; tda_descriptions = ([], labels) }
| _ ->
assert false
let find_type_full path env =
match Path.constructor_typath path with
- | Regular p ->
- (try (Path.Map.find p env.local_constraints, ([], []))
- with Not_found -> find_type_full p env)
+ | Regular p -> begin
+ match Path.Map.find p env.local_constraints with
+ | decl ->
+ { tda_declaration = decl; tda_descriptions = [], [] }
+ | exception Not_found -> find_type_full p env
+ end
| Cstr (ty_path, s) ->
- let (_, (cstrs, _)) =
+ let tda =
try find_type_full ty_path env
with Not_found -> assert false
in
+ let (cstrs, _) = tda.tda_descriptions in
let cstr =
try List.find (fun cstr -> cstr.cstr_name = s) cstrs
with Not_found -> assert false
type_of_cstr path cstr
| LocalExt id ->
let cstr =
- try fst (TycompTbl.find_same id env.constrs)
+ try (TycompTbl.find_same id env.constrs).cda_description
with Not_found -> assert false
in
type_of_cstr path cstr
| Ext (mod_path, s) ->
let comps =
- try find_module_descr mod_path env
+ try find_structure_components mod_path env
with Not_found -> assert false
in
- let comps =
- match get_components comps with
- | Structure_comps c -> c
- | Functor_comps _ -> assert false
- in
- let exts =
- List.filter
- (function ({cstr_tag=Cstr_extension _}, _) -> true | _ -> false)
- (try NameMap.find s comps.comp_constrs
- with Not_found -> assert false)
+ let cstrs =
+ try NameMap.find s comps.comp_constrs
+ with Not_found -> assert false
in
+ let exts = List.filter is_ext cstrs in
match exts with
- | [(cstr, _)] -> type_of_cstr path cstr
+ | [cda] -> type_of_cstr path cda.cda_description
| _ -> assert false
let find_type p env =
- fst (find_type_full p env)
+ (find_type_full p env).tda_declaration
let find_type_descrs p env =
- snd (find_type_full p env)
-
-let find_module ~alias path env =
- match path with
- Pident id ->
- begin
- match find_same_module id env.modules with
- | Value (data, _) -> EnvLazy.force subst_modtype_maker data
- | Persistent ->
- let pm = find_pers_mod (Ident.name id) in
- md (Mty_signature(Lazy.force pm.pm_signature))
- end
- | Pdot(p, s) ->
- begin match get_components (find_module_descr p env) with
- Structure_comps c ->
- let data, _ = NameMap.find s c.comp_modules in
- EnvLazy.force subst_modtype_maker data
- | Functor_comps _ ->
- raise Not_found
- end
- | Papply(p1, p2) ->
- let desc1 = find_module_descr p1 env in
- begin match get_components desc1 with
- Functor_comps f ->
- let mty =
- match f.fcomp_res with
- | Mty_alias _ as mty -> mty
- | mty ->
- if alias then mty else
- try
- Hashtbl.find f.fcomp_subst_cache p2
- with Not_found ->
- let mty =
- Subst.modtype (Rescope (Path.scope path))
- (Subst.add_module f.fcomp_param p2 Subst.identity)
- f.fcomp_res in
- Hashtbl.add f.fcomp_subst_cache p2 mty;
- mty
- in
- md mty
- | Structure_comps _ ->
- raise Not_found
- end
+ (find_type_full p env).tda_descriptions
let rec find_module_address path env =
match path with
- | Pident id ->
- begin
- match find_same_module id env.modules with
- | Value (_, addr) -> get_address addr
- | Persistent -> Aident id
- end
- | Pdot(p, s) -> begin
- match get_components (find_module_descr p env) with
- | Structure_comps c ->
- let _, addr = NameMap.find s c.comp_modules in
- get_address addr
- | Functor_comps _ ->
- raise Not_found
- end
+ | Pident id -> get_address (find_ident_module id env).mda_address
+ | Pdot(p, s) ->
+ let c = find_structure_components p env in
+ get_address (NameMap.find s c.comp_modules).mda_address
| Papply _ -> raise Not_found
and force_address = function
and get_address a =
EnvLazy.force force_address a
-let find_value_address p env =
- get_address (snd (find_value_full p env))
+let find_value_address path env =
+ get_address (find_value_full path env).vda_address
-let find_class_address p env =
- get_address (snd (find_class_full p env))
+let find_class_address path env =
+ get_address (find_class_full path env).clda_address
let rec get_constrs_address = function
| [] -> raise Not_found
- | (_, None) :: rest -> get_constrs_address rest
- | (_, Some a) :: _ -> get_address a
+ | cda :: rest ->
+ match cda.cda_address with
+ | None -> get_constrs_address rest
+ | Some a -> get_address a
let find_constructor_address path env =
match path with
| Pident id -> begin
- match TycompTbl.find_same id env.constrs with
- | _, None -> raise Not_found
- | _, Some addr -> get_address addr
- end
- | Pdot(p, s) -> begin
- match get_components (find_module_descr p env) with
- | Structure_comps c ->
- get_constrs_address (NameMap.find s c.comp_constrs)
- | Functor_comps _ ->
- raise Not_found
+ let cda = TycompTbl.find_same id env.constrs in
+ match cda.cda_address with
+ | None -> raise Not_found
+ | Some addr -> get_address addr
end
+ | Pdot(p, s) ->
+ let c = find_structure_components p env in
+ get_constrs_address (NameMap.find s c.comp_constrs)
+ | Papply _ ->
+ raise Not_found
+
+let find_hash_type path env =
+ match path with
+ | Pident id ->
+ let name = "#" ^ Ident.name id in
+ let _, tda =
+ IdTbl.find_name wrap_identity ~mark:false name env.types
+ in
+ tda.tda_declaration
+ | Pdot(p, s) ->
+ let c = find_structure_components p env in
+ let name = "#" ^ s in
+ let tda = NameMap.find name c.comp_types in
+ tda.tda_declaration
| Papply _ ->
raise Not_found
| Papply _ ->
assert false
-let is_uident s =
- match s.[0] with
- | 'A'..'Z' -> true
- | _ -> false
-
let normalize_type_path oloc env path =
(* Inlined version of Path.is_constructor_typath:
constructor type paths (i.e. path pointing to an inline
path
| Pdot(p, s) ->
let p2 =
- if is_uident s && not (is_uident (Path.last p)) then
+ if Path.is_uident s && not (Path.is_uident (Path.last p)) then
(* Cstr M.t.C *)
normalize_path_prefix oloc env p
else
| Pdot (p, _s) -> is_functor_arg p env
| Papply _ -> true
-(* Lookup by name *)
-
-exception Recmodule
-
-let report_alerts ?loc p alerts =
- match loc with
- | Some loc ->
- Misc.Stdlib.String.Map.iter
- (fun kind message ->
- let message = if message = "" then "" else "\n" ^ message in
- Location.alert ~kind loc
- (Printf.sprintf "module %s%s" (Path.name p) message)
- )
- alerts
- | _ -> ()
-
-let mark_module_used name loc =
- try Hashtbl.find module_declarations (name, loc) ()
- with Not_found -> ()
-
-let rec lookup_module_descr_aux ?loc ~mark lid env =
- match lid with
- Lident s ->
- let find_components s = (find_pers_mod s).pm_components in
- begin match IdTbl.find_name ~mark s env.components with
- | exception Not_found when not (Current_unit_name.is s) ->
- let p = Path.Pident (Ident.create_persistent s) in
- (p, find_components s)
- | (p, data) ->
- (p,
- match data with
- | Value (comp, _) -> comp
- | Persistent -> find_components s)
- end
- | Ldot(l, s) ->
- let (p, descr) = lookup_module_descr ?loc ~mark l env in
- begin match get_components descr with
- Structure_comps c ->
- let (descr, _addr) = NameMap.find s c.comp_components in
- (Pdot(p, s), descr)
- | Functor_comps _ ->
- raise Not_found
- end
- | Lapply(l1, l2) ->
- let (p1, desc1) = lookup_module_descr ?loc ~mark l1 env in
- let p2 = lookup_module ~load:true ~mark ?loc l2 env in
- let {md_type=mty2} = find_module p2 env in
- begin match get_components desc1 with
- Functor_comps f ->
- let loc = match loc with Some l -> l | None -> Location.none in
- (match f.fcomp_arg with
- | None -> raise Not_found (* PR#7611 *)
- | Some arg -> !check_modtype_inclusion ~loc env mty2 p2 arg);
- (Papply(p1, p2), !components_of_functor_appl' f env p1 p2)
- | Structure_comps _ ->
- raise Not_found
- end
-
-and lookup_module_descr ?loc ~mark lid env =
- let (p, comps) as res = lookup_module_descr_aux ?loc ~mark lid env in
- if mark then mark_module_used (Path.last p) comps.loc;
-(*
- Format.printf "USE module %s at %a@." (Path.last p)
- Location.print comps.loc;
-*)
- report_alerts ?loc p comps.alerts;
- res
-
-and lookup_module ~load ?loc ~mark lid env : Path.t =
- match lid with
- Lident s ->
- begin match IdTbl.find_name ~mark s env.modules with
- | exception Not_found
- when not (Current_unit_name.is s)
- && !Clflags.transparent_modules
- && not load ->
- check_pers_mod s
- ~loc:(Option.value loc ~default:Location.none);
- Path.Pident (Ident.create_persistent s)
- | p, data ->
- begin match data with
- | Value (data, _) ->
- let {md_loc; md_attributes; md_type} =
- EnvLazy.force subst_modtype_maker data
- in
- if mark then mark_module_used s md_loc;
- begin match md_type with
- | Mty_ident (Path.Pident id) when Ident.name id = "#recmod#" ->
- (* see #5965 *)
- raise Recmodule
- | _ -> ()
- end;
- report_alerts ?loc p
- (Builtin_attributes.alerts_of_attrs md_attributes)
- | Persistent ->
- if !Clflags.transparent_modules && not load then
- check_pers_mod s
- ~loc:(Option.value loc ~default:Location.none)
- else begin
- let pm = find_pers_mod s in
- report_alerts ?loc p pm.pm_components.alerts
- end
- end;
- p
- end
- | Ldot(l, s) ->
- let (p, descr) = lookup_module_descr ?loc ~mark l env in
- begin match get_components descr with
- Structure_comps c ->
- let (comps, _) = NameMap.find s c.comp_components in
- if mark then mark_module_used s comps.loc;
- let p = Pdot(p, s) in
- report_alerts ?loc p comps.alerts;
- p
- | Functor_comps _ ->
- raise Not_found
- end
- | Lapply(l1, l2) ->
- let (p1, desc1) = lookup_module_descr ?loc ~mark l1 env in
- let p2 = lookup_module ~load:true ?loc ~mark l2 env in
- let {md_type=mty2} = find_module p2 env in
- let p = Papply(p1, p2) in
- begin match get_components desc1 with
- Functor_comps f ->
- let loc = match loc with Some l -> l | None -> Location.none in
- (match f.fcomp_arg with
- | None -> raise Not_found (* PR#7611 *)
- | Some arg -> (!check_modtype_inclusion ~loc env mty2 p2) arg);
- p
- | Structure_comps _ ->
- raise Not_found
- end
-
-let lookup proj1 proj2 ?loc ~mark lid env =
- match lid with
- | Lident s -> IdTbl.find_name ~mark s (proj1 env)
- | Ldot(l, s) ->
- let path, desc = lookup_module_descr ?loc ~mark l env in
- begin match get_components desc with
- Structure_comps c ->
- let data = NameMap.find s (proj2 c) in
- (Pdot(path, s), data)
- | Functor_comps _ ->
- raise Not_found
- end
- | Lapply _ ->
- raise Not_found
-
-let lookup_all_simple proj1 proj2 shadow ?loc ~mark lid env =
- match lid with
- Lident s ->
- let xl = TycompTbl.find_all s (proj1 env) in
- let rec do_shadow =
- function
- | [] -> []
- | ((x, f) :: xs) ->
- (x, f) ::
- (do_shadow (List.filter (fun (y, _) -> not (shadow x y)) xs))
- in
- do_shadow xl
- | Ldot(l, s) ->
- let (_p, desc) = lookup_module_descr ?loc ~mark l env in
- begin match get_components desc with
- Structure_comps c ->
- let comps =
- try NameMap.find s (proj2 c) with Not_found -> []
- in
- List.map
- (fun data -> (data, (fun () -> ())))
- comps
- | Functor_comps _ ->
- raise Not_found
- end
- | Lapply _ ->
- raise Not_found
-
-let has_local_constraints env = not (Path.Map.is_empty env.local_constraints)
-
-let cstr_shadow (cstr1, _) (cstr2, _) =
- match cstr1.cstr_tag, cstr2.cstr_tag with
- | Cstr_extension _, Cstr_extension _ -> true
- | _ -> false
-
-let lbl_shadow _lbl1 _lbl2 = false
-
-let ignore_address (path, (desc, _addr)) = (path, desc)
-
-let lookup_value ?loc ~mark lid env =
- ignore_address
- (lookup (fun env -> env.values) (fun sc -> sc.comp_values)
- ?loc ~mark lid env)
-let lookup_all_constructors ?loc ~mark lid env =
- lookup_all_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
- cstr_shadow ?loc ~mark lid env
-let lookup_all_labels ?loc ~mark lid env =
- lookup_all_simple (fun env -> env.labels) (fun sc -> sc.comp_labels)
- lbl_shadow ?loc ~mark lid env
-let lookup_type ?loc ~mark lid env=
- lookup (fun env -> env.types) (fun sc -> sc.comp_types)
- ?loc ~mark lid env
-let lookup_modtype ?loc ~mark lid env =
- lookup (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
- ?loc ~mark lid env
-let lookup_class ?loc ~mark lid env =
- ignore_address
- (lookup (fun env -> env.classes) (fun sc -> sc.comp_classes)
- ?loc ~mark lid env)
-let lookup_cltype ?loc ~mark lid env =
- lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
- ?loc ~mark lid env
-
-type copy_of_types = {
- to_copy: string list;
- initial_values: (value_description * address_lazy) IdTbl.t;
- new_values: (value_description * address_lazy) IdTbl.t;
-}
-
-let make_copy_of_types l env : copy_of_types =
- let f (desc, addr) =
- {desc with val_type = Subst.type_expr Subst.identity desc.val_type}, addr
+(* Copying types associated with values *)
+
+let make_copy_of_types env0 =
+ let memo = Hashtbl.create 16 in
+ let copy t =
+ try
+ Hashtbl.find memo t.id
+ with Not_found ->
+ let t2 = Subst.type_expr Subst.identity t in
+ Hashtbl.add memo t.id t2;
+ t2
in
- let values =
- List.fold_left (fun env s -> IdTbl.update s f env) env.values l
+ let f = function
+ | Val_unbound _ as entry -> entry
+ | Val_bound vda ->
+ let desc = vda.vda_description in
+ let desc = { desc with val_type = copy desc.val_type } in
+ Val_bound { vda with vda_description = desc }
in
- {to_copy = l; initial_values = env.values; new_values = values}
-
-let do_copy_types { to_copy = l; initial_values; new_values = values } env =
- if initial_values != env.values then fatal_error "Env.do_copy_types";
- {env with values; summary = Env_copy_types (env.summary, l)}
-
-let mark_value_used name vd =
- try Hashtbl.find value_declarations (name, vd.val_loc) ()
- with Not_found -> ()
-
-let mark_type_used name vd =
- try Hashtbl.find type_declarations (name, vd.type_loc) ()
- with Not_found -> ()
-
-let mark_constructor_used usage name vd constr =
- try Hashtbl.find used_constructors (name, vd.type_loc, constr) usage
- with Not_found -> ()
-
-let mark_extension_used usage ext name =
- let ty_name = Path.last ext.ext_type_path in
- try Hashtbl.find used_constructors (ty_name, ext.ext_loc, name) usage
- with Not_found -> ()
-
-let set_value_used_callback name vd callback =
- let key = (name, vd.val_loc) in
- try
- let old = Hashtbl.find value_declarations key in
- Hashtbl.replace value_declarations key (fun () -> old (); callback ())
- (* this is to support cases like:
- let x = let x = 1 in x in x
- where the two declarations have the same location
- (e.g. resulting from Camlp4 expansion of grammar entries) *)
- with Not_found ->
- Hashtbl.add value_declarations key callback
-
-let set_type_used_callback name td callback =
- let loc = td.type_loc in
- if loc.Location.loc_ghost then ()
- else let key = (name, loc) in
- let old =
- try Hashtbl.find type_declarations key
- with Not_found -> ignore
+ let values =
+ IdTbl.map f env0.values
in
- Hashtbl.replace type_declarations key (fun () -> callback old)
-
-let lookup_value ?loc ?(mark = true) lid env =
- let (_, desc) as r = lookup_value ?loc ~mark lid env in
- if mark then mark_value_used (Longident.last lid) desc;
- r
-
-let lookup_type ?loc ?(mark = true) lid env =
- let (path, (decl, _)) = lookup_type ?loc ~mark lid env in
- if mark then mark_type_used (Longident.last lid) decl;
- path
-
-let mark_type_path env path =
- try
- let decl = find_type path env in
- mark_type_used (Path.last path) decl
- with Not_found -> ()
-
-let ty_path t =
- match repr t with
- | {desc=Tconstr(path, _, _)} -> path
- | _ -> assert false
-
-let lookup_constructor ?loc ?(mark = true) lid env =
- match lookup_all_constructors ?loc ~mark lid env with
- [] -> raise Not_found
- | ((desc, _), use) :: _ ->
- if mark then begin
- mark_type_path env (ty_path desc.cstr_res);
- use ()
- end;
- desc
-
-let is_lident = function
- Lident _ -> true
- | _ -> false
-
-let lookup_all_constructors ?loc ?(mark = true) lid env =
- try
- let cstrs = lookup_all_constructors ?loc ~mark lid env in
- let wrap_use desc use () =
- if mark then begin
- mark_type_path env (ty_path desc.cstr_res);
- use ()
- end
- in
- List.map (fun ((cstr, _), use) -> (cstr, wrap_use cstr use)) cstrs
- with
- Not_found when is_lident lid -> []
-
-let mark_constructor usage env name desc =
- match desc.cstr_tag with
- | Cstr_extension _ ->
- begin
- let ty_path = ty_path desc.cstr_res in
- let ty_name = Path.last ty_path in
- try Hashtbl.find used_constructors (ty_name, desc.cstr_loc, name) usage
- with Not_found -> ()
- end
- | _ ->
- let ty_path = ty_path desc.cstr_res in
- let ty_decl = try find_type ty_path env with Not_found -> assert false in
- let ty_name = Path.last ty_path in
- mark_constructor_used usage ty_name ty_decl name
-
-let lookup_label ?loc ?(mark = true) lid env =
- match lookup_all_labels ?loc ~mark lid env with
- [] -> raise Not_found
- | (desc, use) :: _ ->
- if mark then begin
- mark_type_path env (ty_path desc.lbl_res);
- use ()
- end;
- desc
-
-let lookup_all_labels ?loc ?(mark = true) lid env =
- try
- let lbls = lookup_all_labels ?loc ~mark lid env in
- let wrap_use desc use () =
- if mark then begin
- mark_type_path env (ty_path desc.lbl_res);
- use ()
- end
- in
- List.map (fun (lbl, use) -> (lbl, wrap_use lbl use)) lbls
- with
- Not_found when is_lident lid -> []
-
-let lookup_module ~load ?loc ?(mark = true) lid env =
- lookup_module ~load ?loc ~mark lid env
-
-let lookup_modtype ?loc ?(mark = true) lid env =
- lookup_modtype ?loc ~mark lid env
-
-let lookup_class ?loc ?(mark = true) lid env =
- let (_, desc) as r = lookup_class ?loc ~mark lid env in
- (* special support for Typeclass.unbound_class *)
- if Path.name desc.cty_path = "" then ignore (lookup_type ?loc ~mark lid env)
- else if mark then mark_type_path env desc.cty_path;
- r
-
-let lookup_cltype ?loc ?(mark = true) lid env =
- let (_, desc) as r = lookup_cltype ?loc ~mark lid env in
- if Path.name desc.clty_path = "" then ignore (lookup_type ?loc lid env)
- else mark_type_path env desc.clty_path;
- mark_type_path env desc.clty_path;
- r
+ (fun env ->
+ if env.values != env0.values then fatal_error "Env.make_copy_of_types";
+ {env with values; summary = Env_copy_types env.summary}
+ )
(* Helper to handle optional substitutions. *)
type iter_cont = unit -> unit
let iter_env_cont = ref []
-let rec scrape_alias_for_visit env sub mty =
+let rec scrape_alias_for_visit env (sub : Subst.t option) mty =
match mty with
| Mty_alias path ->
begin match may_subst Subst.module_path sub path with
end
| _ -> true
-let iter_env proj1 proj2 f env () =
- IdTbl.iter (fun id x -> f (Pident id) x) (proj1 env);
+let iter_env wrap proj1 proj2 f env () =
+ IdTbl.iter wrap (fun id x -> f (Pident id) x) (proj1 env);
let rec iter_components path path' mcomps =
let cont () =
let visit =
(fun s d -> f (Pdot (path, s)) (Pdot (path', s), d))
(proj2 comps);
NameMap.iter
- (fun s (c, _) ->
- iter_components (Pdot (path, s)) (Pdot (path', s)) c)
- comps.comp_components
+ (fun s mda ->
+ iter_components
+ (Pdot (path, s)) (Pdot (path', s)) mda.mda_components)
+ comps.comp_modules
| Functor_comps _ -> ()
in iter_env_cont := (path, cont) :: !iter_env_cont
in
- IdTbl.iter
- (fun id (path, comps) ->
- match comps with
- | Value (comps, _) -> iter_components (Pident id) path comps
- | Persistent ->
+ IdTbl.iter wrap_module
+ (fun id (path, entry) ->
+ match entry with
+ | Mod_unbound _ -> ()
+ | Mod_local data ->
+ iter_components (Pident id) path data.mda_components
+ | Mod_persistent ->
let modname = Ident.name id in
match Persistent_env.find_in_cache persistent_env modname with
| None -> ()
- | Some pm -> iter_components (Pident id) path pm.pm_components)
- env.components
+ | Some data ->
+ iter_components (Pident id) path data.mda_components)
+ env.modules
let run_iter_cont l =
iter_env_cont := [];
iter_env_cont := [];
cont
-let iter_types f = iter_env (fun env -> env.types) (fun sc -> sc.comp_types) f
+let iter_types f =
+ iter_env wrap_identity (fun env -> env.types) (fun sc -> sc.comp_types)
+ (fun p1 (p2, tda) -> f p1 (p2, tda.tda_declaration))
let same_types env1 env2 =
- env1.types == env2.types && env1.components == env2.components
+ env1.types == env2.types && env1.modules == env2.modules
let used_persistent () =
Persistent_env.fold persistent_env
(fun s _m r -> Concr.add s r)
Concr.empty
-let find_all_comps proj s (p,(mcomps, _)) =
- match get_components mcomps with
+let find_all_comps wrap proj s (p, mda) =
+ match get_components mda.mda_components with
Functor_comps _ -> []
| Structure_comps comps ->
try
let c = NameMap.find s (proj comps) in
- [Pdot(p,s), c]
+ [Pdot(p,s), wrap c]
with Not_found -> []
let rec find_shadowed_comps path env =
match path with
- Pident id ->
+ | Pident id ->
List.filter_map
(fun (p, data) ->
match data with
- | Value x -> Some (p, x)
- | Persistent -> None)
- (IdTbl.find_all (Ident.name id) env.components)
+ | Mod_local x -> Some (p, x)
+ | Mod_unbound _ | Mod_persistent -> None)
+ (IdTbl.find_all wrap_module (Ident.name id) env.modules)
| Pdot (p, s) ->
let l = find_shadowed_comps p env in
let l' =
- List.map (find_all_comps (fun comps -> comps.comp_components) s) l
+ List.map
+ (find_all_comps wrap_identity
+ (fun comps -> comps.comp_modules) s) l
in
List.flatten l'
| Papply _ -> []
-let find_shadowed proj1 proj2 path env =
+let find_shadowed wrap proj1 proj2 path env =
match path with
Pident id ->
- IdTbl.find_all (Ident.name id) (proj1 env)
+ IdTbl.find_all wrap (Ident.name id) (proj1 env)
| Pdot (p, s) ->
let l = find_shadowed_comps p env in
- let l' = List.map (find_all_comps proj2 s) l in
+ let l' = List.map (find_all_comps wrap proj2 s) l in
List.flatten l'
| Papply _ -> []
let find_shadowed_types path env =
List.map fst
- (find_shadowed
+ (find_shadowed wrap_identity
(fun env -> env.types) (fun comps -> comps.comp_types) path env)
(* Expand manifest module type names at the top of the given module type *)
| Mp_present ->
EnvLazy.create_forced (Aident id)
-let rec components_of_module ~alerts ~loc env fs ps path addr mty =
- {
- alerts;
- loc;
- comps = EnvLazy.create {
- cm_env = env;
- cm_freshening_subst = fs;
- cm_prefixing_subst = ps;
- cm_path = path;
- cm_addr = addr;
- cm_mty = mty
- }
- }
-
-and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst;
- cm_path; cm_addr; cm_mty} =
+let rec components_of_module_maker
+ {cm_env; cm_freshening_subst; cm_prefixing_subst;
+ cm_path; cm_addr; cm_mty} : _ result =
match scrape_alias cm_env cm_freshening_subst cm_mty with
Mty_signature sg ->
let c =
comp_constrs = NameMap.empty;
comp_labels = NameMap.empty; comp_types = NameMap.empty;
comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
- comp_components = NameMap.empty; comp_classes = NameMap.empty;
- comp_cltypes = NameMap.empty } in
+ comp_classes = NameMap.empty; comp_cltypes = NameMap.empty }
+ in
let items_and_paths, freshening_sub, prefixing_sub =
prefix_idents cm_path cm_freshening_subst cm_prefixing_subst sg
in
| Val_prim _ -> EnvLazy.create_failed Not_found
| _ -> next_address ()
in
- c.comp_values <-
- NameMap.add (Ident.name id) (decl', addr) c.comp_values;
+ let vda = { vda_description = decl'; vda_address = addr } in
+ c.comp_values <- NameMap.add (Ident.name id) vda c.comp_values;
| Sig_type(id, decl, _, _) ->
let fresh_decl =
may_subst Subst.type_declaration freshening_sub decl
List.map snd (Datarepr.constructors_of_type path final_decl) in
let labels =
List.map snd (Datarepr.labels_of_type path final_decl) in
- c.comp_types <-
- NameMap.add (Ident.name id)
- (final_decl, (constructors, labels))
- c.comp_types;
+ let tda =
+ { tda_declaration = final_decl;
+ tda_descriptions = (constructors, labels); }
+ in
+ c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types;
List.iter
(fun descr ->
- c.comp_constrs <-
- add_to_tbl descr.cstr_name (descr, None) c.comp_constrs)
+ let cda = { cda_description = descr; cda_address = None } in
+ c.comp_constrs <-
+ add_to_tbl descr.cstr_name cda c.comp_constrs)
constructors;
List.iter
(fun descr ->
let ext' = Subst.extension_constructor sub ext in
let descr = Datarepr.extension_descr path ext' in
let addr = next_address () in
- c.comp_constrs <-
- add_to_tbl (Ident.name id) (descr, Some addr) c.comp_constrs
+ let cda = { cda_description = descr; cda_address = Some addr } in
+ c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs
| Sig_module(id, pres, md, _, _) ->
let md' =
(* The prefixed items get the same scope as [cm_path], which is
end
| Mp_present -> next_address ()
in
- c.comp_modules <-
- NameMap.add (Ident.name id) (md', addr) c.comp_modules;
let alerts =
Builtin_attributes.alerts_of_attrs md.md_attributes
in
components_of_module ~alerts ~loc:md.md_loc !env freshening_sub
prefixing_sub path addr md.md_type
in
- c.comp_components <-
- NameMap.add (Ident.name id) (comps, addr) c.comp_components;
+ let mda =
+ { mda_declaration = md';
+ mda_components = comps;
+ mda_address = addr }
+ in
+ c.comp_modules <-
+ NameMap.add (Ident.name id) mda c.comp_modules;
env :=
- store_module ~freshening_sub ~check:false id addr pres md !env
+ store_module ~freshening_sub ~check:None id addr pres md !env
| Sig_modtype(id, decl, _) ->
let fresh_decl =
(* the fresh_decl is only going in the local temporary env, and
env := store_modtype id fresh_decl !env
| Sig_class(id, decl, _, _) ->
let decl' = Subst.class_declaration sub decl in
- c.comp_classes <-
- NameMap.add (Ident.name id) (decl', next_address ())
- c.comp_classes
+ let addr = next_address () in
+ let clda = { clda_declaration = decl'; clda_address = addr } in
+ c.comp_classes <- NameMap.add (Ident.name id) clda c.comp_classes
| Sig_class_type(id, decl, _, _) ->
let decl' = Subst.cltype_declaration sub decl in
c.comp_cltypes <-
NameMap.add (Ident.name id) decl' c.comp_cltypes)
items_and_paths;
- Some (Structure_comps c)
- | Mty_functor(param, ty_arg, ty_res) ->
+ Ok (Structure_comps c)
+ | Mty_functor(arg, ty_res) ->
let sub =
may_subst Subst.compose cm_freshening_subst cm_prefixing_subst
in
let scoping = Subst.Rescope (Path.scope cm_path) in
- Some (Functor_comps {
- fcomp_param = param;
+ Ok (Functor_comps {
(* fcomp_arg and fcomp_res must be prefixed eagerly, because
they are interpreted in the outer environment *)
- fcomp_arg = may_map (Subst.modtype scoping sub) ty_arg;
+ fcomp_arg =
+ (match arg with
+ | Unit -> Unit
+ | Named (param, ty_arg) ->
+ Named (param, Subst.modtype scoping sub ty_arg));
fcomp_res = Subst.modtype scoping sub ty_res;
fcomp_cache = Hashtbl.create 17;
fcomp_subst_cache = Hashtbl.create 17 })
- | Mty_ident _
- | Mty_alias _ -> None
+ | Mty_ident _ -> Error No_components_abstract
+ | Mty_alias p -> Error (No_components_alias p)
(* Insertion of bindings by identifier + path *)
(* Note: we could also check here general validity of the
identifier, to protect against bad identifiers forged by -pp or
-ppx preprocessors. *)
-
if String.length name > 0 && (name.[0] = '#') then
for i = 1 to String.length name - 1 do
if name.[i] = '#' then
error (Illegal_value_name(loc, name))
done
-
and store_value ?check id addr decl env =
check_value_name (Ident.name id) decl.val_loc;
- may (fun f -> check_usage decl.val_loc id f value_declarations) check;
+ Option.iter (fun f -> check_usage decl.val_loc id f value_declarations) check;
+ let vda = { vda_description = decl; vda_address = addr } in
{ env with
- values = IdTbl.add id (decl, addr) env.values;
+ values = IdTbl.add id (Val_bound vda) env.values;
summary = Env_value(env.summary, id, decl) }
and store_type ~check id info env =
let constructors = Datarepr.constructors_of_type path info in
let labels = Datarepr.labels_of_type path info in
let descrs = (List.map snd constructors, List.map snd labels) in
-
+ let tda = { tda_declaration = info; tda_descriptions = descrs } in
if check && not loc.Location.loc_ghost &&
Warnings.is_active (Warnings.Unused_constructor ("", false, false))
then begin
- let ty = Ident.name id in
+ let ty_name = Ident.name id in
+ let priv = info.type_private in
List.iter
- begin fun (_, {cstr_name = c; _}) ->
- let k = (ty, loc, c) in
+ begin fun (_, cstr) ->
+ let name = cstr.cstr_name in
+ let loc = cstr.cstr_loc in
+ let k = (ty_name, loc, name) in
if not (Hashtbl.mem used_constructors k) then
let used = constructor_usages () in
- Hashtbl.add used_constructors k (add_constructor_usage used);
- if not (ty = "" || ty.[0] = '_')
+ Hashtbl.add used_constructors k (add_constructor_usage priv used);
+ if not (ty_name = "" || ty_name.[0] = '_')
then !add_delayed_check_forward
(fun () ->
if not (is_in_signature env) && not used.cu_positive then
Location.prerr_warning loc
(Warnings.Unused_constructor
- (c, used.cu_pattern, used.cu_privatize)))
+ (name, used.cu_pattern, used.cu_privatize)))
end
constructors
end;
{ env with
constrs =
List.fold_right
- (fun (id, descr) constrs -> TycompTbl.add id (descr, None) constrs)
- constructors
- env.constrs;
+ (fun (id, descr) constrs ->
+ let cda = { cda_description = descr; cda_address = None } in
+ TycompTbl.add id cda constrs)
+ constructors env.constrs;
labels =
List.fold_right
(fun (id, descr) labels -> TycompTbl.add id descr labels)
- labels
- env.labels;
- types = IdTbl.add id (info, descrs) env.types;
+ labels env.labels;
+ types = IdTbl.add id tda env.types;
summary = Env_type(env.summary, id, info) }
and store_type_infos id info env =
manifest-ness of the type. Used in components_of_module to
keep track of type abbreviations (e.g. type t = float) in the
computation of label representations. *)
+ let tda = { tda_declaration = info; tda_descriptions = [], [] } in
{ env with
- types = IdTbl.add id (info,([],[])) env.types;
+ types = IdTbl.add id tda env.types;
summary = Env_type(env.summary, id, info) }
and store_extension ~check id addr ext env =
let loc = ext.ext_loc in
+ let cstr = Datarepr.extension_descr (Pident id) ext in
+ let cda = { cda_description = cstr; cda_address = Some addr } in
if check && not loc.Location.loc_ghost &&
Warnings.is_active (Warnings.Unused_extension ("", false, false, false))
then begin
+ let priv = ext.ext_private in
let is_exception = Path.same ext.ext_type_path Predef.path_exn in
- let ty = Path.last ext.ext_type_path in
- let n = Ident.name id in
- let k = (ty, loc, n) in
+ let ty_name = Path.last ext.ext_type_path in
+ let name = cstr.cstr_name in
+ let k = (ty_name, loc, name) in
if not (Hashtbl.mem used_constructors k) then begin
let used = constructor_usages () in
- Hashtbl.add used_constructors k (add_constructor_usage used);
+ Hashtbl.add used_constructors k (add_constructor_usage priv used);
!add_delayed_check_forward
(fun () ->
if not (is_in_signature env) && not used.cu_positive then
Location.prerr_warning loc
(Warnings.Unused_extension
- (n, is_exception, used.cu_pattern, used.cu_privatize)
+ (name, is_exception, used.cu_pattern, used.cu_privatize)
)
)
end;
end;
- let desc = Datarepr.extension_descr (Pident id) ext in
{ env with
- constrs = TycompTbl.add id (desc, Some addr) env.constrs;
+ constrs = TycompTbl.add id cda env.constrs;
summary = Env_extension(env.summary, id, ext) }
and store_module ~check ~freshening_sub id addr presence md env =
let loc = md.md_loc in
- if check then
- check_usage loc id (fun s -> Warnings.Unused_module s)
- module_declarations;
+ Option.iter (fun f -> check_usage loc id f module_declarations) check;
let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
let module_decl_lazy =
match freshening_sub with
| None -> EnvLazy.create_forced md
| Some s -> EnvLazy.create (s, Subst.Rescope (Ident.scope id), md)
in
+ let comps =
+ components_of_module ~alerts ~loc:md.md_loc
+ env freshening_sub Subst.identity (Pident id) addr md.md_type
+ in
+ let mda =
+ { mda_declaration = module_decl_lazy;
+ mda_components = comps;
+ mda_address = addr }
+ in
{ env with
- modules = IdTbl.add id (Value (module_decl_lazy, addr)) env.modules;
- components =
- IdTbl.add id
- (Value
- (components_of_module ~alerts ~loc:md.md_loc
- env freshening_sub Subst.identity (Pident id) addr md.md_type,
- addr))
- env.components;
+ modules = IdTbl.add id (Mod_local mda) env.modules;
summary = Env_module(env.summary, id, presence, md) }
and store_modtype id info env =
summary = Env_modtype(env.summary, id, info) }
and store_class id addr desc env =
+ let clda = { clda_declaration = desc; clda_address = addr } in
{ env with
- classes = IdTbl.add id (desc, addr) env.classes;
+ classes = IdTbl.add id clda env.classes;
summary = Env_class(env.summary, id, desc) }
and store_cltype id desc env =
(* Compute the components of a functor application in a path. *)
-let components_of_functor_appl f env p1 p2 =
+let components_of_functor_appl ~loc f env p1 p2 =
try
Hashtbl.find f.fcomp_cache p2
with Not_found ->
let p = Papply(p1, p2) in
- let sub = Subst.add_module f.fcomp_param p2 Subst.identity in
+ let sub =
+ match f.fcomp_arg with
+ | Unit
+ | Named (None, _) -> Subst.identity
+ | Named (Some param, _) -> Subst.add_module param p2 Subst.identity
+ in
(* we have to apply eagerly instead of passing sub to [components_of_module]
because of the call to [check_well_formed_module]. *)
let mty = Subst.modtype (Rescope (Path.scope p)) sub f.fcomp_res in
let addr = EnvLazy.create_failed Not_found in
- !check_well_formed_module env Location.(in_file !input_name)
+ !check_well_formed_module env loc
("the signature of " ^ Path.name p) mty;
let comps =
components_of_module ~alerts:Misc.Stdlib.String.Map.empty
(* Define forward functions *)
let _ =
- components_of_module' := components_of_module;
components_of_functor_appl' := components_of_functor_appl;
components_of_module_maker' := components_of_module_maker
store_extension ~check id addr ext env
and add_module_declaration ?(arg=false) ~check id presence md env =
+ let check =
+ if not check then
+ None
+ else if arg && is_in_signature env then
+ Some (fun s -> Warnings.Unused_functor_parameter s)
+ else
+ Some (fun s -> Warnings.Unused_module s)
+ in
let addr = module_declaration_address env id presence md in
let env = store_module ~freshening_sub:None ~check id addr presence md env in
if arg then add_functor_arg id env else env
let env = store_extension ~check:true id addr ext env in
(id, env)
-let enter_module_declaration ?arg id presence md env =
- add_module_declaration ?arg ~check:true id presence md env
+let enter_module_declaration ~scope ?arg s presence md env =
+ let id = Ident.create_scoped ~scope s in
+ (id, add_module_declaration ?arg ~check:true id presence md env)
let enter_modtype ~scope name mtd env =
let id = Ident.create_scoped ~scope name in
(id, env)
let enter_module ~scope ?arg s presence mty env =
- let id = Ident.create_scoped ~scope s in
- let env = enter_module_declaration ?arg id presence (md mty) env in
- (id, env)
+ enter_module_declaration ~scope ?arg s presence (md mty) env
(* Insertion of all components of a signature *)
let sg = Subst.signature (Rescope scope) Subst.identity sg in
sg, add_signature sg env
+(* Add "unbound" bindings *)
+
+let enter_unbound_value name reason env =
+ let id = Ident.create_local name in
+ { env with
+ values = IdTbl.add id (Val_unbound reason) env.values;
+ summary = Env_value_unbound(env.summary, name, reason) }
+
+let enter_unbound_module name reason env =
+ let id = Ident.create_local name in
+ { env with
+ modules = IdTbl.add id (Mod_unbound reason) env.modules;
+ summary = Env_module_unbound(env.summary, name, reason) }
+
(* Open a signature path *)
let add_components slot root env0 comps =
let add_l w comps env0 =
TycompTbl.add_open slot w comps env0
in
-
let add w comps env0 = IdTbl.add_open slot w root comps env0 in
-
let constrs =
add_l (fun x -> `Constructor x) comps.comp_constrs env0.constrs
in
let labels =
add_l (fun x -> `Label x) comps.comp_labels env0.labels
in
-
let values =
add (fun x -> `Value x) comps.comp_values env0.values
in
let cltypes =
add (fun x -> `Class_type x) comps.comp_cltypes env0.cltypes
in
- let components =
- let components =
- NameMap.map (fun x -> Value x) comps.comp_components
- in
- add (fun x -> `Component x) components env0.components
- in
-
let modules =
- let modules =
- NameMap.map (fun x -> Value x) comps.comp_modules
- in
- add (fun x -> `Module x) modules env0.modules
+ add (fun x -> `Module x) comps.comp_modules env0.modules
in
-
{ env0 with
summary = Env_open(env0.summary, root);
constrs;
modtypes;
classes;
cltypes;
- components;
modules;
}
let open_signature slot root env0 =
- match get_components (find_module_descr root env0) with
+ match get_components (find_module_components root env0) with
| Functor_comps _ -> None
| Structure_comps comps ->
Some (add_components slot root env0 comps)
(* Read a signature from a file *)
let read_signature modname filename =
- let pm = read_pers_mod modname filename in
- Lazy.force pm.pm_signature
+ let mda = read_pers_mod modname filename in
+ let md = EnvLazy.force subst_modtype_maker mda.mda_declaration in
+ match md.md_type with
+ | Mty_signature sg -> sg
+ | Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false
let is_identchar_latin1 = function
| 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246'
save_signature_with_transform with_imports
~alerts sg modname filename
+(* Make the initial environment *)
+let (initial_safe_string, initial_unsafe_string) =
+ Predef.build_initial_env
+ (add_type ~check:false)
+ (add_extension ~check:false)
+ empty
+
+(* Tracking usage *)
+
+let mark_module_used name loc =
+ match Hashtbl.find module_declarations (name, loc) with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_modtype_used _name _mtd = ()
+
+let mark_value_used name vd =
+ match Hashtbl.find value_declarations (name, vd.val_loc) with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_type_used name td =
+ match Hashtbl.find type_declarations (name, td.type_loc) with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_type_path_used env path =
+ match find_type path env with
+ | decl -> mark_type_used (Path.last path) decl
+ | exception Not_found -> ()
+
+let mark_constructor_used usage ty_name cd =
+ let name = Ident.name cd.cd_id in
+ let loc = cd.cd_loc in
+ let k = (ty_name, loc, name) in
+ match Hashtbl.find used_constructors k with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_extension_used usage name ext =
+ let ty_name = Path.last ext.ext_type_path in
+ let loc = ext.ext_loc in
+ let k = (ty_name, loc, name) in
+ match Hashtbl.find used_constructors k with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_constructor_description_used usage env cstr =
+ let ty_path =
+ match repr cstr.cstr_res with
+ | {desc=Tconstr(path, _, _)} -> path
+ | _ -> assert false
+ in
+ mark_type_path_used env ty_path;
+ let ty_name = Path.last ty_path in
+ let k = (ty_name, cstr.cstr_loc, cstr.cstr_name) in
+ match Hashtbl.find used_constructors k with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
+let mark_label_description_used () env lbl =
+ let ty_path =
+ match repr lbl.lbl_res with
+ | {desc=Tconstr(path, _, _)} -> path
+ | _ -> assert false
+ in
+ mark_type_path_used env ty_path
+
+let mark_class_used name cty =
+ match Hashtbl.find type_declarations (name, cty.cty_loc) with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let mark_cltype_used name clty =
+ match Hashtbl.find type_declarations (name, clty.clty_loc) with
+ | mark -> mark ()
+ | exception Not_found -> ()
+
+let set_value_used_callback name vd callback =
+ let key = (name, vd.val_loc) in
+ try
+ let old = Hashtbl.find value_declarations key in
+ Hashtbl.replace value_declarations key (fun () -> old (); callback ())
+ (* this is to support cases like:
+ let x = let x = 1 in x in x
+ where the two declarations have the same location
+ (e.g. resulting from Camlp4 expansion of grammar entries) *)
+ with Not_found ->
+ Hashtbl.add value_declarations key callback
+
+let set_type_used_callback name td callback =
+ let loc = td.type_loc in
+ if loc.Location.loc_ghost then ()
+ else let key = (name, loc) in
+ let old =
+ try Hashtbl.find type_declarations key
+ with Not_found -> ignore
+ in
+ Hashtbl.replace type_declarations key (fun () -> callback old)
+
+(* Lookup by name *)
+
+let may_lookup_error report_errors loc env err =
+ if report_errors then lookup_error loc env err
+ else raise Not_found
+
+let report_module_unbound ~errors ~loc env reason =
+ match reason with
+ | Mod_unbound_illegal_recursion ->
+ (* see #5965 *)
+ may_lookup_error errors loc env Illegal_reference_to_recursive_module
+
+let report_value_unbound ~errors ~loc env reason lid =
+ match reason with
+ | Val_unbound_instance_variable ->
+ may_lookup_error errors loc env (Masked_instance_variable lid)
+ | Val_unbound_self ->
+ may_lookup_error errors loc env (Masked_self_variable lid)
+ | Val_unbound_ancestor ->
+ may_lookup_error errors loc env (Masked_ancestor_variable lid)
+ | Val_unbound_ghost_recursive rloc ->
+ let show_hint =
+ (* Only display the "missing rec" hint for non-ghost code *)
+ not loc.Location.loc_ghost
+ && not rloc.Location.loc_ghost
+ in
+ let hint =
+ if show_hint then Missing_rec rloc else No_hint
+ in
+ may_lookup_error errors loc env (Unbound_value(lid, hint))
+
+let use_module ~use ~loc name path mda =
+ if use then begin
+ let comps = mda.mda_components in
+ mark_module_used name comps.loc;
+ Misc.Stdlib.String.Map.iter
+ (fun kind message ->
+ let message = if message = "" then "" else "\n" ^ message in
+ Location.alert ~kind loc
+ (Printf.sprintf "module %s%s" (Path.name path) message)
+ )
+ comps.alerts
+ end
+
+let use_value ~use ~loc name path vda =
+ if use then begin
+ let desc = vda.vda_description in
+ mark_value_used name desc;
+ Builtin_attributes.check_alerts loc desc.val_attributes
+ (Path.name path)
+ end
+
+let use_type ~use ~loc name path tda =
+ if use then begin
+ let decl = tda.tda_declaration in
+ mark_type_used name decl;
+ Builtin_attributes.check_alerts loc decl.type_attributes
+ (Path.name path)
+ end
+
+let use_modtype ~use ~loc name path desc =
+ if use then begin
+ mark_modtype_used name desc;
+ Builtin_attributes.check_alerts loc desc.mtd_attributes
+ (Path.name path)
+ end
+
+let use_class ~use ~loc name path clda =
+ if use then begin
+ let desc = clda.clda_declaration in
+ mark_class_used name desc;
+ Builtin_attributes.check_alerts loc desc.cty_attributes
+ (Path.name path)
+ end
+
+let use_cltype ~use ~loc name path desc =
+ if use then begin
+ mark_cltype_used name desc;
+ Builtin_attributes.check_alerts loc desc.clty_attributes
+ (Path.name path)
+ end
+
+let use_label ~use ~loc env lbl =
+ if use then begin
+ mark_label_description_used () env lbl;
+ Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name
+ end
+
+let use_constructor_desc ~use ~loc usage env cstr =
+ if use then begin
+ mark_constructor_description_used usage env cstr;
+ Builtin_attributes.check_alerts loc cstr.cstr_attributes cstr.cstr_name
+ end
+
+let use_constructor ~use ~loc usage env cda =
+ use_constructor_desc ~use ~loc usage env cda.cda_description
+
+type _ load =
+ | Load : module_data load
+ | Don't_load : unit load
+
+let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
+ let path, data =
+ match find_name_module ~mark:use s env.modules with
+ | res -> res
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_module (Lident s))
+ in
+ match data with
+ | Mod_local mda -> begin
+ use_module ~use ~loc s path mda;
+ match load with
+ | Load -> path, (mda : a)
+ | Don't_load -> path, (() : a)
+ end
+ | Mod_unbound reason ->
+ report_module_unbound ~errors ~loc env reason
+ | Mod_persistent -> begin
+ match load with
+ | Don't_load ->
+ check_pers_mod ~loc s;
+ path, (() : a)
+ | Load -> begin
+ match find_pers_mod s with
+ | mda ->
+ use_module ~use ~loc s path mda;
+ path, (mda : a)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_module (Lident s))
+ end
+ end
+
+let lookup_ident_value ~errors ~use ~loc name env =
+ match IdTbl.find_name wrap_value ~mark:use name env.values with
+ | (path, Val_bound vda) ->
+ use_value ~use ~loc name path vda;
+ path, vda.vda_description
+ | (_, Val_unbound reason) ->
+ report_value_unbound ~errors ~loc env reason (Lident name)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_value (Lident name, No_hint))
+
+let lookup_ident_type ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.types with
+ | (path, data) as res ->
+ use_type ~use ~loc s path data;
+ res
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_type (Lident s))
+
+let lookup_ident_modtype ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.modtypes with
+ | (path, data) as res ->
+ use_modtype ~use ~loc s path data;
+ res
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_modtype (Lident s))
+
+let lookup_ident_class ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.classes with
+ | (path, clda) ->
+ use_class ~use ~loc s path clda;
+ path, clda.clda_declaration
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_class (Lident s))
+
+let lookup_ident_cltype ~errors ~use ~loc s env =
+ match IdTbl.find_name wrap_identity ~mark:use s env.cltypes with
+ | (path, data) as res ->
+ use_cltype ~use ~loc s path data;
+ res
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_cltype (Lident s))
+
+let lookup_all_ident_labels ~errors ~use ~loc s env =
+ match TycompTbl.find_all ~mark:use s env.labels with
+ | [] -> may_lookup_error errors loc env (Unbound_label (Lident s))
+ | lbls -> begin
+ List.map
+ (fun (lbl, use_fn) ->
+ let use_fn () =
+ use_label ~use ~loc env lbl;
+ use_fn ()
+ in
+ (lbl, use_fn))
+ lbls
+ end
+
+(* Drop all extension constructors *)
+let drop_exts cstrs =
+ List.filter (fun (cda, _) -> not (is_ext cda)) cstrs
+
+(* Only keep the latest extension constructor *)
+let rec filter_shadowed_constructors cstrs =
+ match cstrs with
+ | (cda, _) as hd :: tl ->
+ if is_ext cda then hd :: drop_exts tl
+ else hd :: filter_shadowed_constructors tl
+ | [] -> []
+
+let lookup_all_ident_constructors ~errors ~use ~loc usage s env =
+ match TycompTbl.find_all ~mark:use s env.constrs with
+ | [] -> may_lookup_error errors loc env (Unbound_constructor (Lident s))
+ | cstrs ->
+ let cstrs = filter_shadowed_constructors cstrs in
+ List.map
+ (fun (cda, use_fn) ->
+ let use_fn () =
+ use_constructor ~use ~loc usage env cda;
+ use_fn ()
+ in
+ (cda.cda_description, use_fn))
+ cstrs
+
+let rec lookup_module_components ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s ->
+ let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
+ path, data.mda_components
+ | Ldot(l, s) ->
+ let path, data = lookup_dot_module ~errors ~use ~loc l s env in
+ path, data.mda_components
+ | Lapply(l1, l2) ->
+ let p1, f, arg = lookup_functor_components ~errors ~use ~loc l1 env in
+ let p2, md = lookup_module ~errors ~use ~loc l2 env in
+ !check_functor_application ~errors ~loc env md.md_type p2 arg p1;
+ let comps = !components_of_functor_appl' ~loc f env p1 p2 in
+ (Papply(p1, p2), comps)
+
+and lookup_structure_components ~errors ~use ~loc lid env =
+ let path, comps = lookup_module_components ~errors ~use ~loc lid env in
+ match get_components_res comps with
+ | Ok (Structure_comps comps) -> path, comps
+ | Ok (Functor_comps _) ->
+ may_lookup_error errors loc env (Functor_used_as_structure lid)
+ | Error No_components_abstract ->
+ may_lookup_error errors loc env (Abstract_used_as_structure lid)
+ | Error (No_components_alias p) ->
+ may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+
+and lookup_functor_components ~errors ~use ~loc lid env =
+ let path, comps = lookup_module_components ~errors ~use ~loc lid env in
+ match get_components_res comps with
+ | Ok (Functor_comps fcomps) -> begin
+ match fcomps.fcomp_arg with
+ | Unit -> (* PR#7611 *)
+ may_lookup_error errors loc env (Generative_used_as_applicative lid)
+ | Named (_, arg) -> path, fcomps, arg
+ end
+ | Ok (Structure_comps _) ->
+ may_lookup_error errors loc env (Structure_used_as_functor lid)
+ | Error No_components_abstract ->
+ may_lookup_error errors loc env (Abstract_used_as_functor lid)
+ | Error (No_components_alias p) ->
+ may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+
+and lookup_module ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s ->
+ let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
+ let md = EnvLazy.force subst_modtype_maker data.mda_declaration in
+ path, md
+ | Ldot(l, s) ->
+ let path, data = lookup_dot_module ~errors ~use ~loc l s env in
+ let md = EnvLazy.force subst_modtype_maker data.mda_declaration in
+ path, md
+ | Lapply(l1, l2) ->
+ let p1, fc, arg = lookup_functor_components ~errors ~use ~loc l1 env in
+ let p2, md2 = lookup_module ~errors ~use ~loc l2 env in
+ !check_functor_application ~errors ~loc env md2.md_type p2 arg p1;
+ let md = md (modtype_of_functor_appl fc p1 p2) in
+ Papply(p1, p2), md
+
+and lookup_dot_module ~errors ~use ~loc l s env =
+ let p, comps = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_modules with
+ | mda ->
+ let path = Pdot(p, s) in
+ use_module ~use ~loc s path mda;
+ (path, mda)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_module (Ldot(l, s)))
+
+let lookup_dot_value ~errors ~use ~loc l s env =
+ let (path, comps) =
+ lookup_structure_components ~errors ~use ~loc l env
+ in
+ match NameMap.find s comps.comp_values with
+ | vda ->
+ let path = Pdot(path, s) in
+ use_value ~use ~loc s path vda;
+ (path, vda.vda_description)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_value (Ldot(l, s), No_hint))
+
+let lookup_dot_type ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_types with
+ | tda ->
+ let path = Pdot(p, s) in
+ use_type ~use ~loc s path tda;
+ (path, tda)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_type (Ldot(l, s)))
+
+let lookup_dot_modtype ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_modtypes with
+ | desc ->
+ let path = Pdot(p, s) in
+ use_modtype ~use ~loc s path desc;
+ (path, desc)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_modtype (Ldot(l, s)))
+
+let lookup_dot_class ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_classes with
+ | clda ->
+ let path = Pdot(p, s) in
+ use_class ~use ~loc s path clda;
+ (path, clda.clda_declaration)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_class (Ldot(l, s)))
+
+let lookup_dot_cltype ~errors ~use ~loc l s env =
+ let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_cltypes with
+ | desc ->
+ let path = Pdot(p, s) in
+ use_cltype ~use ~loc s path desc;
+ (path, desc)
+ | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s)))
+
+let lookup_all_dot_labels ~errors ~use ~loc l s env =
+ let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_labels with
+ | [] | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_label (Ldot(l, s)))
+ | lbls ->
+ List.map
+ (fun lbl ->
+ let use_fun () = use_label ~use ~loc env lbl in
+ (lbl, use_fun))
+ lbls
+
+let lookup_all_dot_constructors ~errors ~use ~loc usage l s env =
+ match l with
+ | Longident.Lident "*predef*" ->
+ (* Hack to support compilation of default arguments *)
+ lookup_all_ident_constructors
+ ~errors ~use ~loc usage s initial_safe_string
+ | _ ->
+ let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
+ match NameMap.find s comps.comp_constrs with
+ | [] | exception Not_found ->
+ may_lookup_error errors loc env (Unbound_constructor (Ldot(l, s)))
+ | cstrs ->
+ List.map
+ (fun cda ->
+ let use_fun () = use_constructor ~use ~loc usage env cda in
+ (cda.cda_description, use_fun))
+ cstrs
+
+(* General forms of the lookup functions *)
+
+let lookup_module_path ~errors ~use ~loc ~load lid env : Path.t =
+ match lid with
+ | Lident s ->
+ if !Clflags.transparent_modules && not load then
+ fst (lookup_ident_module Don't_load ~errors ~use ~loc s env)
+ else
+ fst (lookup_ident_module Load ~errors ~use ~loc s env)
+ | Ldot(l, s) -> fst (lookup_dot_module ~errors ~use ~loc l s env)
+ | Lapply(l1, l2) ->
+ let (p1, _, arg) = lookup_functor_components ~errors ~use ~loc l1 env in
+ let p2, md2 = lookup_module ~errors ~use ~loc l2 env in
+ !check_functor_application ~errors ~loc env md2.md_type p2 arg p1;
+ Papply(p1, p2)
+
+let lookup_value ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_value ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_value ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_type_full ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_type ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_type ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_type ~errors ~use ~loc lid env =
+ let (path, tda) = lookup_type_full ~errors ~use ~loc lid env in
+ path, tda.tda_declaration
+
+let lookup_modtype ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_modtype ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_modtype ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_class ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_class ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_class ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_cltype ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_ident_cltype ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_dot_cltype ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_all_labels ~errors ~use ~loc lid env =
+ match lid with
+ | Lident s -> lookup_all_ident_labels ~errors ~use ~loc s env
+ | Ldot(l, s) -> lookup_all_dot_labels ~errors ~use ~loc l s env
+ | Lapply _ -> assert false
+
+let lookup_label ~errors ~use ~loc lid env =
+ match lookup_all_labels ~errors ~use ~loc lid env with
+ | [] -> assert false
+ | (desc, use) :: _ -> use (); desc
+
+let lookup_all_labels_from_type ~use ~loc ty_path env =
+ match find_type_descrs ty_path env with
+ | exception Not_found -> []
+ | (_, lbls) ->
+ List.map
+ (fun lbl ->
+ let use_fun () = use_label ~use ~loc env lbl in
+ (lbl, use_fun))
+ lbls
+
+let lookup_all_constructors ~errors ~use ~loc usage lid env =
+ match lid with
+ | Lident s -> lookup_all_ident_constructors ~errors ~use ~loc usage s env
+ | Ldot(l, s) -> lookup_all_dot_constructors ~errors ~use ~loc usage l s env
+ | Lapply _ -> assert false
+
+let lookup_constructor ~errors ~use ~loc usage lid env =
+ match lookup_all_constructors ~errors ~use ~loc usage lid env with
+ | [] -> assert false
+ | (desc, use) :: _ -> use (); desc
+
+let lookup_all_constructors_from_type ~use ~loc usage ty_path env =
+ match find_type_descrs ty_path env with
+ | exception Not_found -> []
+ | (cstrs, _) ->
+ List.map
+ (fun cstr ->
+ let use_fun () =
+ use_constructor_desc ~use ~loc usage env cstr
+ in
+ (cstr, use_fun))
+ cstrs
+
+(* Lookup functions that do not mark the item as used or
+ warn if it has alerts, and raise [Not_found] rather
+ than report errors *)
+
+let find_module_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_module ~errors:false ~use:false ~loc lid env
+
+let find_value_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_value ~errors:false ~use:false ~loc lid env
+
+let find_type_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_type ~errors:false ~use:false ~loc lid env
+
+let find_modtype_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_modtype ~errors:false ~use:false ~loc lid env
+
+let find_class_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_class ~errors:false ~use:false ~loc lid env
+
+let find_cltype_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_cltype ~errors:false ~use:false ~loc lid env
+
+let find_constructor_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_constructor ~errors:false ~use:false ~loc Positive lid env
+
+let find_label_by_name lid env =
+ let loc = Location.(in_file !input_name) in
+ lookup_label ~errors:false ~use:false ~loc lid env
+
+(* Ordinary lookup functions *)
+
+let lookup_module_path ?(use=true) ~loc ~load lid env =
+ lookup_module_path ~errors:true ~use ~loc ~load lid env
+
+let lookup_module ?(use=true) ~loc lid env =
+ lookup_module ~errors:true ~use ~loc lid env
+
+let lookup_value ?(use=true) ~loc lid env =
+ check_value_name (Longident.last lid) loc;
+ lookup_value ~errors:true ~use ~loc lid env
+
+let lookup_type ?(use=true) ~loc lid env =
+ lookup_type ~errors:true ~use ~loc lid env
+
+let lookup_modtype ?(use=true) ~loc lid env =
+ lookup_modtype ~errors:true ~use ~loc lid env
+
+let lookup_class ?(use=true) ~loc lid env =
+ lookup_class ~errors:true ~use ~loc lid env
+
+let lookup_cltype ?(use=true) ~loc lid env =
+ lookup_cltype ~errors:true ~use ~loc lid env
+
+let lookup_all_constructors ?(use=true) ~loc usage lid env =
+ match lookup_all_constructors ~errors:true ~use ~loc usage lid env with
+ | exception Error(Lookup_error(loc', env', err)) ->
+ (Error(loc', env', err) : _ result)
+ | cstrs -> Ok cstrs
+
+let lookup_constructor ?(use=true) ~loc lid env =
+ lookup_constructor ~errors:true ~use ~loc lid env
+
+let lookup_all_constructors_from_type ?(use=true) ~loc usage ty_path env =
+ lookup_all_constructors_from_type ~use ~loc usage ty_path env
+
+let lookup_all_labels ?(use=true) ~loc lid env =
+ match lookup_all_labels ~errors:true ~use ~loc lid env with
+ | exception Error(Lookup_error(loc', env', err)) ->
+ (Error(loc', env', err) : _ result)
+ | lbls -> Ok lbls
+
+let lookup_label ?(use=true) ~loc lid env =
+ lookup_label ~errors:true ~use ~loc lid env
+
+let lookup_all_labels_from_type ?(use=true) ~loc ty_path env =
+ lookup_all_labels_from_type ~use ~loc ty_path env
+
+let lookup_instance_variable ?(use=true) ~loc name env =
+ match IdTbl.find_name wrap_value ~mark:use name env.values with
+ | (path, Val_bound vda) -> begin
+ let desc = vda.vda_description in
+ match desc.val_kind with
+ | Val_ivar(mut, cl_num) ->
+ use_value ~use ~loc name path vda;
+ path, mut, cl_num, desc.val_type
+ | _ ->
+ lookup_error loc env (Not_an_instance_variable name)
+ end
+ | (_, Val_unbound Val_unbound_instance_variable) ->
+ lookup_error loc env (Masked_instance_variable (Lident name))
+ | (_, Val_unbound Val_unbound_self) ->
+ lookup_error loc env (Not_an_instance_variable name)
+ | (_, Val_unbound Val_unbound_ancestor) ->
+ lookup_error loc env (Not_an_instance_variable name)
+ | (_, Val_unbound Val_unbound_ghost_recursive _) ->
+ lookup_error loc env (Unbound_instance_variable name)
+ | exception Not_found ->
+ lookup_error loc env (Unbound_instance_variable name)
+
+(* Checking if a name is bound *)
+
+let bound_module name env =
+ match IdTbl.find_name wrap_module ~mark:false name env.modules with
+ | _ -> true
+ | exception Not_found ->
+ if Current_unit_name.is name then false
+ else begin
+ match find_pers_mod name with
+ | _ -> true
+ | exception Not_found -> false
+ end
+
+let bound wrap proj name env =
+ match IdTbl.find_name wrap ~mark:false name (proj env) with
+ | _ -> true
+ | exception Not_found -> false
+
+let bound_value name env =
+ bound wrap_value (fun env -> env.values) name env
+
+let bound_type name env =
+ bound wrap_identity (fun env -> env.types) name env
+
+let bound_modtype name env =
+ bound wrap_identity (fun env -> env.modtypes) name env
+
+let bound_class name env =
+ bound wrap_identity (fun env -> env.classes) name env
+
+let bound_cltype name env =
+ bound wrap_identity (fun env -> env.cltypes) name env
+
(* Folding on environments *)
-let find_all proj1 proj2 f lid env acc =
+let find_all wrap proj1 proj2 f lid env acc =
match lid with
- | None ->
- IdTbl.fold_name
+ | None ->
+ IdTbl.fold_name wrap
(fun name (p, data) acc -> f name p data acc)
(proj1 env) acc
- | Some l ->
- let p, desc = lookup_module_descr ~mark:true l env in
+ | Some l ->
+ let p, desc =
+ lookup_module_components
+ ~errors:false ~use:false ~loc:Location.none l env
+ in
begin match get_components desc with
- Structure_comps c ->
- NameMap.fold
- (fun s data acc -> f s (Pdot (p, s)) data acc)
- (proj2 c) acc
- | Functor_comps _ ->
- acc
+ | Structure_comps c ->
+ NameMap.fold
+ (fun s data acc -> f s (Pdot (p, s)) (wrap data) acc)
+ (proj2 c) acc
+ | Functor_comps _ ->
+ acc
end
let find_all_simple_list proj1 proj2 f lid env acc =
match lid with
- | None ->
+ | None ->
TycompTbl.fold_name
(fun data acc -> f data acc)
(proj1 env) acc
- | Some l ->
- let (_p, desc) = lookup_module_descr ~mark:true l env in
+ | Some l ->
+ let (_p, desc) =
+ lookup_module_components
+ ~errors:false ~use:false ~loc:Location.none l env
+ in
begin match get_components desc with
- Structure_comps c ->
- NameMap.fold
- (fun _s comps acc ->
- match comps with
- | [] -> acc
- | data :: _ -> f data acc)
- (proj2 c) acc
- | Functor_comps _ ->
- acc
+ | Structure_comps c ->
+ NameMap.fold
+ (fun _s comps acc ->
+ match comps with
+ | [] -> acc
+ | data :: _ -> f data acc)
+ (proj2 c) acc
+ | Functor_comps _ ->
+ acc
end
let fold_modules f lid env acc =
match lid with
| None ->
- IdTbl.fold_name
- (fun name (p, data) acc ->
- match data with
- | Value (data, _) ->
- let data = EnvLazy.force subst_modtype_maker data in
- f name p data acc
- | Persistent ->
+ IdTbl.fold_name wrap_module
+ (fun name (p, entry) acc ->
+ match entry with
+ | Mod_unbound _ -> acc
+ | Mod_local mda ->
+ let md =
+ EnvLazy.force subst_modtype_maker mda.mda_declaration
+ in
+ f name p md acc
+ | Mod_persistent ->
match Persistent_env.find_in_cache persistent_env name with
| None -> acc
- | Some pm ->
- let data = md (Mty_signature (Lazy.force pm.pm_signature)) in
- f name p data acc)
+ | Some mda ->
+ let md =
+ EnvLazy.force subst_modtype_maker mda.mda_declaration
+ in
+ f name p md acc)
env.modules
acc
| Some l ->
- let p, desc = lookup_module_descr ~mark:true l env in
+ let p, desc =
+ lookup_module_components
+ ~errors:false ~use:false ~loc:Location.none l env
+ in
begin match get_components desc with
| Structure_comps c ->
NameMap.fold
- (fun s (data, _) acc ->
- f s (Pdot (p, s))
- (EnvLazy.force subst_modtype_maker data) acc)
+ (fun s mda acc ->
+ let md =
+ EnvLazy.force subst_modtype_maker mda.mda_declaration
+ in
+ f s (Pdot (p, s)) md acc)
c.comp_modules
acc
| Functor_comps _ ->
end
let fold_values f =
- find_all (fun env -> env.values) (fun sc -> sc.comp_values)
- (fun k p (vd, _) acc -> f k p vd acc)
+ find_all wrap_value (fun env -> env.values) (fun sc -> sc.comp_values)
+ (fun k p ve acc ->
+ match ve with
+ | Val_unbound _ -> acc
+ | Val_bound vda -> f k p vda.vda_description acc)
and fold_constructors f =
find_all_simple_list (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
- (fun (cd, _) acc -> f cd acc)
+ (fun cda acc -> f cda.cda_description acc)
and fold_labels f =
find_all_simple_list (fun env -> env.labels) (fun sc -> sc.comp_labels) f
and fold_types f =
- find_all (fun env -> env.types) (fun sc -> sc.comp_types) f
+ find_all wrap_identity
+ (fun env -> env.types) (fun sc -> sc.comp_types)
+ (fun k p tda acc -> f k p tda.tda_declaration acc)
and fold_modtypes f =
- find_all (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
+ find_all wrap_identity
+ (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
and fold_classes f =
- find_all (fun env -> env.classes) (fun sc -> sc.comp_classes)
- (fun k p (vd, _) acc -> f k p vd acc)
+ find_all wrap_identity (fun env -> env.classes) (fun sc -> sc.comp_classes)
+ (fun k p clda acc -> f k p clda.clda_declaration acc)
and fold_cltypes f =
- find_all (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f
+ find_all wrap_identity
+ (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f
let filter_non_loaded_persistent f env =
let to_remove =
- IdTbl.fold_name
- (fun name (_, data) acc ->
- match data with
- | Value _ -> acc
- | Persistent ->
+ IdTbl.fold_name wrap_module
+ (fun name (_, entry) acc ->
+ match entry with
+ | Mod_local _ -> acc
+ | Mod_unbound _ -> acc
+ | Mod_persistent ->
match Persistent_env.find_in_cache persistent_env name with
| Some _ -> acc
| None ->
Env_functor_arg (filter_summary s ids, id)
| Env_constraints (s, cstrs) ->
Env_constraints (filter_summary s ids, cstrs)
- | Env_copy_types (s, types) ->
- Env_copy_types (filter_summary s ids, types)
+ | Env_copy_types s ->
+ Env_copy_types (filter_summary s ids)
| Env_persistent (s, id) ->
if String.Set.mem (Ident.name id) ids then
filter_summary s (String.Set.remove (Ident.name id) ids)
else
Env_persistent (filter_summary s ids, id)
+ | Env_value_unbound (s, n, r) ->
+ Env_value_unbound (filter_summary s ids, n, r)
+ | Env_module_unbound (s, n, r) ->
+ Env_module_unbound (filter_summary s ids, n, r)
in
{ env with
modules = remove_ids env.modules to_remove;
- components = remove_ids env.components to_remove;
summary = filter_summary env.summary to_remove;
}
-(* Make the initial environment *)
-let (initial_safe_string, initial_unsafe_string) =
- Predef.build_initial_env
- (add_type ~check:false)
- (add_extension ~check:false)
- empty
-
(* Return the environment summary *)
let summary env =
open Format
+(* Forward declarations *)
+
+let print_longident =
+ ref ((fun _ _ -> assert false) : formatter -> Longident.t -> unit)
+
+let print_path =
+ ref ((fun _ _ -> assert false) : formatter -> Path.t -> unit)
+
+let spellcheck ppf extract env lid =
+ let choices ~path name = Misc.spellcheck (extract path env) name in
+ match lid with
+ | Longident.Lapply _ -> ()
+ | Longident.Lident s ->
+ Misc.did_you_mean ppf (fun () -> choices ~path:None s)
+ | Longident.Ldot (r, s) ->
+ Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s)
+
+let spellcheck_name ppf extract env name =
+ Misc.did_you_mean ppf
+ (fun () -> Misc.spellcheck (extract env) name)
+
+let extract_values path env =
+ fold_values (fun name _ _ acc -> name :: acc) path env []
+let extract_types path env =
+ fold_types (fun name _ _ acc -> name :: acc) path env []
+let extract_modules path env =
+ fold_modules (fun name _ _ acc -> name :: acc) path env []
+let extract_constructors path env =
+ fold_constructors (fun desc acc -> desc.cstr_name :: acc) path env []
+let extract_labels path env =
+ fold_labels (fun desc acc -> desc.lbl_name :: acc) path env []
+let extract_classes path env =
+ fold_classes (fun name _ _ acc -> name :: acc) path env []
+let extract_modtypes path env =
+ fold_modtypes (fun name _ _ acc -> name :: acc) path env []
+let extract_cltypes path env =
+ fold_cltypes (fun name _ _ acc -> name :: acc) path env []
+let extract_instance_variables env =
+ fold_values
+ (fun name _ descr acc ->
+ match descr.val_kind with
+ | Val_ivar _ -> name :: acc
+ | _ -> acc) None env []
+
+let report_lookup_error _loc env ppf = function
+ | Unbound_value(lid, hint) -> begin
+ fprintf ppf "Unbound value %a" !print_longident lid;
+ spellcheck ppf extract_values env lid;
+ match hint with
+ | No_hint -> ()
+ | Missing_rec def_loc ->
+ let (_, line, _) =
+ Location.get_pos_info def_loc.Location.loc_start
+ in
+ fprintf ppf
+ "@.@[%s@ %s %i@]"
+ "Hint: If this is a recursive definition,"
+ "you should add the 'rec' keyword on line"
+ line
+ end
+ | Unbound_type lid ->
+ fprintf ppf "Unbound type constructor %a" !print_longident lid;
+ spellcheck ppf extract_types env lid;
+ | Unbound_module lid ->
+ fprintf ppf "Unbound module %a" !print_longident lid;
+ spellcheck ppf extract_modules env lid;
+ | Unbound_constructor lid ->
+ fprintf ppf "Unbound constructor %a" !print_longident lid;
+ spellcheck ppf extract_constructors env lid;
+ | Unbound_label lid ->
+ fprintf ppf "Unbound record field %a" !print_longident lid;
+ spellcheck ppf extract_labels env lid;
+ | Unbound_class lid ->
+ fprintf ppf "Unbound class %a" !print_longident lid;
+ spellcheck ppf extract_classes env lid;
+ | Unbound_modtype lid ->
+ fprintf ppf "Unbound module type %a" !print_longident lid;
+ spellcheck ppf extract_modtypes env lid;
+ | Unbound_cltype lid ->
+ fprintf ppf "Unbound class type %a" !print_longident lid;
+ spellcheck ppf extract_cltypes env lid;
+ | Unbound_instance_variable s ->
+ fprintf ppf "Unbound instance variable %s" s;
+ spellcheck_name ppf extract_instance_variables env s;
+ | Not_an_instance_variable s ->
+ fprintf ppf "The value %s is not an instance variable" s;
+ spellcheck_name ppf extract_instance_variables env s;
+ | Masked_instance_variable lid ->
+ fprintf ppf
+ "The instance variable %a@ \
+ cannot be accessed from the definition of another instance variable"
+ !print_longident lid
+ | Masked_self_variable lid ->
+ fprintf ppf
+ "The self variable %a@ \
+ cannot be accessed from the definition of an instance variable"
+ !print_longident lid
+ | Masked_ancestor_variable lid ->
+ fprintf ppf
+ "The ancestor variable %a@ \
+ cannot be accessed from the definition of an instance variable"
+ !print_longident lid
+ | Illegal_reference_to_recursive_module ->
+ fprintf ppf "Illegal recursive module reference"
+ | Structure_used_as_functor lid ->
+ fprintf ppf "@[The module %a is a structure, it cannot be applied@]"
+ !print_longident lid
+ | Abstract_used_as_functor lid ->
+ fprintf ppf "@[The module %a is abstract, it cannot be applied@]"
+ !print_longident lid
+ | Functor_used_as_structure lid ->
+ fprintf ppf "@[The module %a is a functor, \
+ it cannot have any components@]" !print_longident lid
+ | Abstract_used_as_structure lid ->
+ fprintf ppf "@[The module %a is abstract, \
+ it cannot have any components@]" !print_longident lid
+ | Generative_used_as_applicative lid ->
+ fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
+ applied@ in@ type@ expressions@]" !print_longident lid
+ | Cannot_scrape_alias(lid, p) ->
+ fprintf ppf
+ "The module %a is an alias for module %a, which is missing"
+ !print_longident lid !print_path p
+
let report_error ppf = function
| Missing_module(_, path1, path2) ->
fprintf ppf "@[@[<hov>";
| Illegal_value_name(_loc, name) ->
fprintf ppf "'%s' is not a valid value identifier."
name
+ | Lookup_error(loc, t, err) -> report_lookup_error loc t ppf err
let () =
Location.register_error_of_exn
(function
| Error err ->
- let loc = match err with
- (Missing_module (loc, _, _) | Illegal_value_name (loc, _)) -> loc
+ let loc =
+ match err with
+ | Missing_module (loc, _, _)
+ | Illegal_value_name (loc, _)
+ | Lookup_error(loc, _, _) -> loc
in
let error_of_printer =
if loc = Location.none
then Location.error_of_printer_file
- else Location.error_of_printer ~loc ?sub:None in
+ else Location.error_of_printer ~loc ?sub:None
+ in
Some (error_of_printer report_error err)
| _ ->
None
open Types
open Misc
+type value_unbound_reason =
+ | Val_unbound_instance_variable
+ | Val_unbound_self
+ | Val_unbound_ancestor
+ | Val_unbound_ghost_recursive of Location.t
+
+type module_unbound_reason =
+ | Mod_unbound_illegal_recursion
+
type summary =
Env_empty
| Env_value of summary * Ident.t * value_description
to skip, i.e. that won't be imported in the toplevel namespace. *)
| Env_functor_arg of summary * Ident.t
| Env_constraints of summary * type_declaration Path.Map.t
- | Env_copy_types of summary * string list
+ | Env_copy_types of summary
| Env_persistent of summary * Ident.t
+ | Env_value_unbound of summary * string * value_unbound_reason
+ | Env_module_unbound of summary * string * module_unbound_reason
type address =
| Aident of Ident.t
(* For short-paths *)
type iter_cont
val iter_types:
- (Path.t -> Path.t * (type_declaration * type_descriptions) -> unit) ->
+ (Path.t -> Path.t * type_declaration -> unit) ->
t -> iter_cont
val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list
val same_types: t -> t -> bool
val find_class: Path.t -> t -> class_declaration
val find_cltype: Path.t -> t -> class_type_declaration
+val find_ident_constructor: Ident.t -> t -> constructor_description
+val find_ident_label: Ident.t -> t -> label_description
+
val find_type_expansion:
Path.t -> t -> type_expr list * type_expr * int
val find_type_expansion_opt:
of the compiler's type-based optimisations. *)
val find_modtype_expansion: Path.t -> t -> module_type
+val find_hash_type: Path.t -> t -> type_declaration
+(* Find the "#t" type given the path for "t" *)
+
val find_value_address: Path.t -> t -> address
val find_module_address: Path.t -> t -> address
val find_class_address: Path.t -> t -> address
val has_local_constraints: t -> bool
+(* Mark definitions as used *)
+val mark_value_used: string -> value_description -> unit
+val mark_module_used: string -> Location.t -> unit
+val mark_type_used: string -> type_declaration -> unit
+
+type constructor_usage = Positive | Pattern | Privatize
+val mark_constructor_used:
+ constructor_usage -> string -> constructor_declaration -> unit
+val mark_extension_used:
+ constructor_usage -> string -> extension_constructor -> unit
+
(* Lookup by long identifiers *)
-(* ?loc is used to report 'deprecated module' warnings and other alerts *)
+(* Lookup errors *)
+
+type unbound_value_hint =
+ | No_hint
+ | Missing_rec of Location.t
+
+type lookup_error =
+ | Unbound_value of Longident.t * unbound_value_hint
+ | Unbound_type of Longident.t
+ | Unbound_constructor of Longident.t
+ | Unbound_label of Longident.t
+ | Unbound_module of Longident.t
+ | Unbound_class of Longident.t
+ | Unbound_modtype of Longident.t
+ | Unbound_cltype of Longident.t
+ | Unbound_instance_variable of string
+ | Not_an_instance_variable of string
+ | Masked_instance_variable of Longident.t
+ | Masked_self_variable of Longident.t
+ | Masked_ancestor_variable of Longident.t
+ | Structure_used_as_functor of Longident.t
+ | Abstract_used_as_functor of Longident.t
+ | Functor_used_as_structure of Longident.t
+ | Abstract_used_as_structure of Longident.t
+ | Generative_used_as_applicative of Longident.t
+ | Illegal_reference_to_recursive_module
+ | Cannot_scrape_alias of Longident.t * Path.t
+
+val lookup_error: Location.t -> t -> lookup_error -> 'a
+
+(* The [lookup_foo] functions will emit proper error messages (by
+ raising [Error]) if the identifier cannot be found, whereas the
+ [find_foo_by_name] functions will raise [Not_found] instead.
+
+ The [~use] parameters of the [lookup_foo] functions control
+ whether this lookup should be counted as a use for usage
+ warnings and alerts.
+
+ [Longident.t]s in the program source should be looked up using
+ [lookup_foo ~use:true] exactly one time -- otherwise warnings may be
+ emitted the wrong number of times. *)
val lookup_value:
- ?loc:Location.t -> ?mark:bool ->
- Longident.t -> t -> Path.t * value_description
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * value_description
+val lookup_type:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * type_declaration
+val lookup_module:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * module_declaration
+val lookup_modtype:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * modtype_declaration
+val lookup_class:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * class_declaration
+val lookup_cltype:
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ Path.t * class_type_declaration
+
+val lookup_module_path:
+ ?use:bool -> loc:Location.t -> load:bool -> Longident.t -> t -> Path.t
+
val lookup_constructor:
- ?loc:Location.t -> ?mark:bool -> Longident.t -> t -> constructor_description
+ ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
+ constructor_description
val lookup_all_constructors:
- ?loc:Location.t -> ?mark:bool ->
- Longident.t -> t -> (constructor_description * (unit -> unit)) list
+ ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
+ ((constructor_description * (unit -> unit)) list,
+ Location.t * t * lookup_error) result
+val lookup_all_constructors_from_type:
+ ?use:bool -> loc:Location.t -> constructor_usage -> Path.t -> t ->
+ (constructor_description * (unit -> unit)) list
+
val lookup_label:
- ?loc:Location.t -> ?mark:bool ->
- Longident.t -> t -> label_description
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ label_description
val lookup_all_labels:
- ?loc:Location.t -> ?mark:bool ->
- Longident.t -> t -> (label_description * (unit -> unit)) list
-val lookup_type:
- ?loc:Location.t -> ?mark:bool -> Longident.t -> t -> Path.t
- (* Since 4.04, this function no longer returns [type_description].
- To obtain it, you should either call [Env.find_type], or replace
- it by [Typetexp.find_type] *)
-val lookup_module:
- load:bool -> ?loc:Location.t -> ?mark:bool -> Longident.t -> t -> Path.t
-val lookup_modtype:
- ?loc:Location.t -> ?mark:bool ->
+ ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ ((label_description * (unit -> unit)) list,
+ Location.t * t * lookup_error) result
+val lookup_all_labels_from_type:
+ ?use:bool -> loc:Location.t -> Path.t -> t ->
+ (label_description * (unit -> unit)) list
+
+val lookup_instance_variable:
+ ?use:bool -> loc:Location.t -> string -> t ->
+ Path.t * Asttypes.mutable_flag * string * type_expr
+
+val find_value_by_name:
+ Longident.t -> t -> Path.t * value_description
+val find_type_by_name:
+ Longident.t -> t -> Path.t * type_declaration
+val find_module_by_name:
+ Longident.t -> t -> Path.t * module_declaration
+val find_modtype_by_name:
Longident.t -> t -> Path.t * modtype_declaration
-val lookup_class:
- ?loc:Location.t -> ?mark:bool ->
+val find_class_by_name:
Longident.t -> t -> Path.t * class_declaration
-val lookup_cltype:
- ?loc:Location.t -> ?mark:bool ->
+val find_cltype_by_name:
Longident.t -> t -> Path.t * class_type_declaration
-type copy_of_types
-val make_copy_of_types: string list -> t -> copy_of_types
-val do_copy_types: copy_of_types -> t -> t
-(** [do_copy_types copy env] will raise a fatal error if the values in
- [env] are different from the env passed to [make_copy_of_types]. *)
+val find_constructor_by_name:
+ Longident.t -> t -> constructor_description
+val find_label_by_name:
+ Longident.t -> t -> label_description
+
+(* Check if a name is bound *)
+
+val bound_value: string -> t -> bool
+val bound_module: string -> t -> bool
+val bound_type: string -> t -> bool
+val bound_modtype: string -> t -> bool
+val bound_class: string -> t -> bool
+val bound_cltype: string -> t -> bool
-exception Recmodule
- (* Raise by lookup_module when the identifier refers
- to one of the modules of a recursive definition
- during the computation of its approximation (see #5965). *)
+val make_copy_of_types: t -> (t -> t)
(* Insertion by identifier *)
scope:int -> ?arg:bool -> string -> module_presence ->
module_type -> t -> Ident.t * t
val enter_module_declaration:
- ?arg:bool -> Ident.t -> module_presence -> module_declaration -> t -> t
+ scope:int -> ?arg:bool -> string -> module_presence ->
+ module_declaration -> t -> Ident.t * t
val enter_modtype:
scope:int -> string -> modtype_declaration -> t -> Ident.t * t
val enter_class: scope:int -> string -> class_declaration -> t -> Ident.t * t
in the process. *)
val enter_signature: scope:int -> signature -> t -> signature * t
+val enter_unbound_value : string -> value_unbound_reason -> t -> t
+
+val enter_unbound_module : string -> module_unbound_reason -> t -> t
+
(* Initialize the cache of in-core module interfaces. *)
val reset_cache: unit -> unit
type error =
| Missing_module of Location.t * Path.t * Path.t
| Illegal_value_name of Location.t * string
+ | Lookup_error of Location.t * t * lookup_error
exception Error of error
val report_error: formatter -> error -> unit
-
-val mark_value_used: string -> value_description -> unit
-val mark_module_used: string -> Location.t -> unit
-val mark_type_used: string -> type_declaration -> unit
-
-type constructor_usage = Positive | Pattern | Privatize
-val mark_constructor_used:
- constructor_usage -> string -> type_declaration -> string -> unit
-val mark_constructor:
- constructor_usage -> t -> string -> constructor_description -> unit
-val mark_extension_used:
- constructor_usage -> extension_constructor -> string -> unit
+val report_lookup_error: Location.t -> t -> formatter -> lookup_error -> unit
val in_signature: bool -> t -> t
string -> type_declaration -> ((unit -> unit) -> unit) -> unit
(* Forward declaration to break mutual recursion with Includemod. *)
-val check_modtype_inclusion:
- (loc:Location.t -> t -> module_type -> Path.t -> module_type -> unit) ref
+val check_functor_application:
+ (errors:bool -> loc:Location.t -> t -> module_type ->
+ Path.t -> module_type -> Path.t -> unit) ref
(* Forward declaration to break mutual recursion with Typemod. *)
val check_well_formed_module:
(t -> Location.t -> string -> module_type -> unit) ref
(aliasable:bool -> t -> module_type -> Path.t -> module_type) ref
(* Forward declaration to break mutual recursion with Ctype. *)
val same_constr: (t -> type_expr -> type_expr -> bool) ref
-
-(** Folding over all identifiers (for analysis purpose) *)
-
-val fold_values:
- (string -> Path.t -> value_description -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-val fold_types:
- (string -> Path.t -> type_declaration * type_descriptions -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-val fold_constructors:
- (constructor_description -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-val fold_labels:
- (label_description -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-
-(** Persistent structures are only traversed if they are already loaded. *)
-val fold_modules:
- (string -> Path.t -> module_declaration -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-
-val fold_modtypes:
- (string -> Path.t -> modtype_declaration -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-val fold_classes:
- (string -> Path.t -> class_declaration -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
-val fold_cltypes:
- (string -> Path.t -> class_type_declaration -> 'a -> 'a) ->
- Longident.t option -> t -> 'a -> 'a
+(* Forward declaration to break mutual recursion with Printtyp. *)
+val print_longident: (Format.formatter -> Longident.t -> unit) ref
+(* Forward declaration to break mutual recursion with Printtyp. *)
+val print_path: (Format.formatter -> Path.t -> unit) ref
(** Utilities *)
val scrape_alias: t -> module_type -> module_type
Env.add_local_type (Subst.type_path subst path)
(Subst.type_declaration subst info))
map (env_from_summary s subst)
- | Env_copy_types (s, sl) ->
+ | Env_copy_types s ->
let env = env_from_summary s subst in
- Env.do_copy_types (Env.make_copy_of_types sl env) env
+ Env.make_copy_of_types env env
| Env_persistent (s, id) ->
let env = env_from_summary s subst in
Env.add_persistent_structure id env
+ | Env_value_unbound (s, str, reason) ->
+ let env = env_from_summary s subst in
+ Env.enter_unbound_value str reason env
+ | Env_module_unbound (s, str, reason) ->
+ let env = env_from_summary s subst in
+ Env.enter_unbound_module str reason env
in
Hashtbl.add env_cache (sum, subst) env;
env
| CM_Hide_virtual (k, lab) ->
fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab
| CM_Public_method lab ->
- fprintf ppf "@[The public method %s cannot become private" lab
+ fprintf ppf "@[The public method %s cannot become private@]" lab
| CM_Virtual_method lab ->
- fprintf ppf "@[The virtual method %s cannot become concrete" lab
+ fprintf ppf "@[The virtual method %s cannot become concrete@]" lab
| CM_Private_method lab ->
- fprintf ppf "The private method %s cannot become public" lab
+ fprintf ppf "@[The private method %s cannot become public@]" lab
let report_error ppf = function
| [] -> ()
(* Inclusion between type declarations *)
+type position = Ctype.Unification_trace.position = First | Second
+
+let choose ord first second =
+ match ord with
+ | First -> first
+ | Second -> second
+
+let choose_other ord first second =
+ match ord with
+ | First -> choose Second first second
+ | Second -> choose First first second
+
+type label_mismatch =
+ | Type
+ | Mutability of position
+
+type record_mismatch =
+ | Label_mismatch of Types.label_declaration
+ * Types.label_declaration
+ * label_mismatch
+ | Label_names of int * Ident.t * Ident.t
+ | Label_missing of position * Ident.t
+ | Unboxed_float_representation of position
+
+type constructor_mismatch =
+ | Type
+ | Arity
+ | Inline_record of record_mismatch
+ | Kind of position
+ | Explicit_return_type of position
+
+type variant_mismatch =
+ | Constructor_mismatch of Types.constructor_declaration
+ * Types.constructor_declaration
+ * constructor_mismatch
+ | Constructor_names of int * Ident.t * Ident.t
+ | Constructor_missing of position * Ident.t
+
+type extension_constructor_mismatch =
+ | Constructor_privacy
+ | Constructor_mismatch of Ident.t
+ * Types.extension_constructor
+ * Types.extension_constructor
+ * constructor_mismatch
+
type type_mismatch =
- Arity
+ | Arity
| Privacy
| Kind
| Constraint
| Manifest
| Variance
- | Field_type of Ident.t
- | Field_mutable of Ident.t
- | Field_arity of Ident.t
- | Field_names of int * Ident.t * Ident.t
- | Field_missing of bool * Ident.t
- | Record_representation of bool (* true means second one is unboxed float *)
- | Unboxed_representation of bool (* true means second one is unboxed *)
- | Immediate
+ | Record_mismatch of record_mismatch
+ | Variant_mismatch of variant_mismatch
+ | Unboxed_representation of position
+ | Immediate of Type_immediacy.Violation.t
-let report_type_mismatch0 first second decl ppf err =
+let report_label_mismatch first second ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match (err : label_mismatch) with
+ | Type -> pr "The types are not equal."
+ | Mutability ord ->
+ pr "%s is mutable and %s is not."
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+
+let report_record_mismatch first second decl ppf err =
let pr fmt = Format.fprintf ppf fmt in
match err with
- Arity -> pr "They have different arities"
- | Privacy -> pr "A private type would be revealed"
- | Kind -> pr "Their kinds differ"
- | Constraint -> pr "Their constraints differ"
- | Manifest -> ()
- | Variance -> pr "Their variances do not agree"
- | Field_type s ->
- pr "The types for field %s are not equal" (Ident.name s)
- | Field_mutable s ->
- pr "The mutability of field %s is different" (Ident.name s)
- | Field_arity s ->
- pr "The arities for field %s differ" (Ident.name s)
- | Field_names (n, name1, name2) ->
- pr "Fields number %i have different names, %s and %s"
+ | Label_mismatch (l1, l2, err) ->
+ pr
+ "@[<hv>Fields do not match:@;<1 2>%a@ is not compatible with:\
+ @;<1 2>%a@ %a"
+ Printtyp.label l1
+ Printtyp.label l2
+ (report_label_mismatch first second) err
+ | Label_names (n, name1, name2) ->
+ pr "@[<hv>Fields number %i have different names, %s and %s.@]"
n (Ident.name name1) (Ident.name name2)
- | Field_missing (b, s) ->
- pr "The field %s is only present in %s %s"
- (Ident.name s) (if b then second else first) decl
- | Record_representation b ->
- pr "Their internal representations differ:@ %s %s %s"
- (if b then second else first) decl
+ | Label_missing (ord, s) ->
+ pr "@[<hv>The field %s is only present in %s %s.@]"
+ (Ident.name s) (choose ord first second) decl
+ | Unboxed_float_representation ord ->
+ pr "@[<hv>Their internal representations differ:@ %s %s %s.@]"
+ (choose ord first second) decl
"uses unboxed float representation"
- | Unboxed_representation b ->
- pr "Their internal representations differ:@ %s %s %s"
- (if b then second else first) decl
+
+let report_constructor_mismatch first second decl ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match (err : constructor_mismatch) with
+ | Type -> pr "The types are not equal."
+ | Arity -> pr "They have different arities."
+ | Inline_record err -> report_record_mismatch first second decl ppf err
+ | Kind ord ->
+ pr "%s uses inline records and %s doesn't."
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+ | Explicit_return_type ord ->
+ pr "%s has explicit return type and %s doesn't."
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+
+let report_variant_mismatch first second decl ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match (err : variant_mismatch) with
+ | Constructor_mismatch (c1, c2, err) ->
+ pr
+ "@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
+ @;<1 2>%a@ %a"
+ Printtyp.constructor c1
+ Printtyp.constructor c2
+ (report_constructor_mismatch first second decl) err
+ | Constructor_names (n, name1, name2) ->
+ pr "Constructors number %i have different names, %s and %s."
+ n (Ident.name name1) (Ident.name name2)
+ | Constructor_missing (ord, s) ->
+ pr "The constructor %s is only present in %s %s."
+ (Ident.name s) (choose ord first second) decl
+
+let report_extension_constructor_mismatch first second decl ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match (err : extension_constructor_mismatch) with
+ | Constructor_privacy -> pr "A private type would be revealed."
+ | Constructor_mismatch (id, ext1, ext2, err) ->
+ pr "@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
+ @;<1 2>%a@ %a@]"
+ (Printtyp.extension_only_constructor id) ext1
+ (Printtyp.extension_only_constructor id) ext2
+ (report_constructor_mismatch first second decl) err
+
+let report_type_mismatch0 first second decl ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match err with
+ | Arity -> pr "They have different arities."
+ | Privacy -> pr "A private type would be revealed."
+ | Kind -> pr "Their kinds differ."
+ | Constraint -> pr "Their constraints differ."
+ | Manifest -> ()
+ | Variance -> pr "Their variances do not agree."
+ | Record_mismatch err -> report_record_mismatch first second decl ppf err
+ | Variant_mismatch err -> report_variant_mismatch first second decl ppf err
+ | Unboxed_representation ord ->
+ pr "Their internal representations differ:@ %s %s %s."
+ (choose ord first second) decl
"uses unboxed representation"
- | Immediate -> pr "%s is not an immediate type" first
+ | Immediate violation ->
+ let first = StringLabels.capitalize_ascii first in
+ match violation with
+ | Type_immediacy.Violation.Not_always_immediate ->
+ pr "%s is not an immediate type." first
+ | Type_immediacy.Violation.Not_always_immediate_on_64bits ->
+ pr "%s is not a type that is always immediate on 64 bit platforms."
+ first
let report_type_mismatch first second decl ppf err =
if err = Manifest then () else
- Format.fprintf ppf "@ %a." (report_type_mismatch0 first second decl) err
+ Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
-let rec compare_constructor_arguments ~loc env cstr params1 params2 arg1 arg2 =
+let rec compare_constructor_arguments ~loc env params1 params2 arg1 arg2 =
match arg1, arg2 with
| Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
- if List.length arg1 <> List.length arg2 then Some (Field_arity cstr)
+ if List.length arg1 <> List.length arg2 then
+ Some (Arity : constructor_mismatch)
else if
(* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
Ctype.equal env true (params1 @ arg1) (params2 @ arg2)
- then None else Some (Field_type cstr)
+ then None else Some Type
| Types.Cstr_record l1, Types.Cstr_record l2 ->
- compare_records env ~loc params1 params2 0 l1 l2
- | _ -> Some (Field_type cstr)
+ Option.map
+ (fun rec_err -> Inline_record rec_err)
+ (compare_records env ~loc params1 params2 0 l1 l2)
+ | Types.Cstr_record _, _ -> Some (Kind First : constructor_mismatch)
+ | _, Types.Cstr_record _ -> Some (Kind Second : constructor_mismatch)
+
+and compare_constructors ~loc env params1 params2 res1 res2 args1 args2 =
+ match res1, res2 with
+ | Some r1, Some r2 ->
+ if Ctype.equal env true [r1] [r2] then
+ compare_constructor_arguments ~loc env [r1] [r2] args1 args2
+ else Some Type
+ | Some _, None -> Some (Explicit_return_type First)
+ | None, Some _ -> Some (Explicit_return_type Second)
+ | None, None ->
+ compare_constructor_arguments ~loc env params1 params2 args1 args2
and compare_variants ~loc env params1 params2 n
(cstrs1 : Types.constructor_declaration list)
(cstrs2 : Types.constructor_declaration list) =
match cstrs1, cstrs2 with
- [], [] -> None
- | [], c::_ -> Some (Field_missing (true, c.Types.cd_id))
- | c::_, [] -> Some (Field_missing (false, c.Types.cd_id))
+ | [], [] -> None
+ | [], c::_ -> Some (Constructor_missing (Second, c.Types.cd_id))
+ | c::_, [] -> Some (Constructor_missing (First, c.Types.cd_id))
| cd1::rem1, cd2::rem2 ->
if Ident.name cd1.cd_id <> Ident.name cd2.cd_id then
- Some (Field_names (n, cd1.cd_id, cd2.cd_id))
+ Some (Constructor_names (n, cd1.cd_id, cd2.cd_id))
else begin
Builtin_attributes.check_alerts_inclusion
~def:cd1.cd_loc
loc
cd1.cd_attributes cd2.cd_attributes
(Ident.name cd1.cd_id);
- let r =
- match cd1.cd_res, cd2.cd_res with
- | Some r1, Some r2 ->
- if Ctype.equal env true [r1] [r2] then
- compare_constructor_arguments ~loc env cd1.cd_id [r1] [r2]
- cd1.cd_args cd2.cd_args
- else Some (Field_type cd1.cd_id)
- | Some _, None | None, Some _ ->
- Some (Field_type cd1.cd_id)
- | _ ->
- compare_constructor_arguments ~loc env cd1.cd_id
- params1 params2 cd1.cd_args cd2.cd_args
- in
- if r <> None then r
- else compare_variants ~loc env params1 params2 (n+1) rem1 rem2
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some r ->
+ Some ((Constructor_mismatch (cd1, cd2, r)) : variant_mismatch)
+ | None -> compare_variants ~loc env params1 params2 (n+1) rem1 rem2
end
+and compare_labels env params1 params2
+ (ld1 : Types.label_declaration)
+ (ld2 : Types.label_declaration) =
+ if ld1.ld_mutable <> ld2.ld_mutable
+ then
+ let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
+ Some (Mutability ord)
+ else
+ if Ctype.equal env true (ld1.ld_type::params1) (ld2.ld_type::params2)
+ then None
+ else Some (Type : label_mismatch)
and compare_records ~loc env params1 params2 n
(labels1 : Types.label_declaration list)
(labels2 : Types.label_declaration list) =
match labels1, labels2 with
- [], [] -> None
- | [], l::_ -> Some (Field_missing (true, l.Types.ld_id))
- | l::_, [] -> Some (Field_missing (false, l.Types.ld_id))
+ | [], [] -> None
+ | [], l::_ -> Some (Label_missing (Second, l.Types.ld_id))
+ | l::_, [] -> Some (Label_missing (First, l.Types.ld_id))
| ld1::rem1, ld2::rem2 ->
if Ident.name ld1.ld_id <> Ident.name ld2.ld_id
- then Some (Field_names (n, ld1.ld_id, ld2.ld_id))
- else if ld1.ld_mutable <> ld2.ld_mutable then
- Some (Field_mutable ld1.ld_id)
+ then Some (Label_names (n, ld1.ld_id, ld2.ld_id))
else begin
Builtin_attributes.check_deprecated_mutable_inclusion
~def:ld1.ld_loc
loc
ld1.ld_attributes ld2.ld_attributes
(Ident.name ld1.ld_id);
- if Ctype.equal env true (ld1.ld_type::params1)(ld2.ld_type::params2)
- then (* add arguments to the parameters, cf. PR#7378 *)
- compare_records ~loc env
- (ld1.ld_type::params1) (ld2.ld_type::params2)
- (n+1)
- rem1 rem2
- else
- Some (Field_type ld1.ld_id)
+ match compare_labels env params1 params2 ld1 ld2 with
+ | Some r -> Some (Label_mismatch (ld1, ld2, r))
+ (* add arguments to the parameters, cf. PR#7378 *)
+ | None -> compare_records ~loc env
+ (ld1.ld_type::params1) (ld2.ld_type::params2)
+ (n+1)
+ rem1 rem2
end
-let type_declarations ?(equality = false) ~loc env ~mark name decl1 path decl2 =
+let compare_records_with_representation ~loc env params1 params2 n
+ labels1 labels2 rep1 rep2
+ =
+ match compare_records ~loc env params1 params2 n labels1 labels2 with
+ | None when rep1 <> rep2 ->
+ let pos = if rep2 = Record_float then Second else First in
+ Some (Unboxed_float_representation pos)
+ | err -> err
+
+let type_declarations ?(equality = false) ~loc env ~mark name
+ decl1 path decl2 =
Builtin_attributes.check_alerts_inclusion
~def:decl1.type_loc
~use:decl2.type_loc
match (decl2.type_kind, decl1.type_unboxed.unboxed,
decl2.type_unboxed.unboxed) with
| Type_abstract, _, _ -> None
- | _, true, false -> Some (Unboxed_representation false)
- | _, false, true -> Some (Unboxed_representation true)
+ | _, true, false -> Some (Unboxed_representation First)
+ | _, false, true -> Some (Unboxed_representation Second)
| _ -> None
in
if err <> None then err else
(_, Type_abstract) -> None
| (Type_variant cstrs1, Type_variant cstrs2) ->
if mark then begin
- let mark cstrs usage name decl =
+ let mark usage name cstrs =
List.iter
- (fun c ->
- Env.mark_constructor_used usage name decl
- (Ident.name c.Types.cd_id))
+ (fun cstr ->
+ Env.mark_constructor_used usage name cstr)
cstrs
in
let usage =
- if decl1.type_private = Private || decl2.type_private = Public
- then Env.Positive else Env.Privatize
+ if decl2.type_private = Public then Env.Positive
+ else Env.Privatize
in
- mark cstrs1 usage name decl1;
- if equality then mark cstrs2 Env.Positive (Path.name path) decl2
+ mark usage name cstrs1;
+ if equality then mark Env.Positive (Path.name path) cstrs2
end;
- compare_variants ~loc env decl1.type_params
- decl2.type_params 1 cstrs1 cstrs2
+ Option.map
+ (fun var_err -> Variant_mismatch var_err)
+ (compare_variants ~loc env decl1.type_params decl2.type_params 1
+ cstrs1 cstrs2)
| (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
- let err =
- compare_records ~loc env decl1.type_params
- decl2.type_params 1 labels1 labels2
- in
- if err <> None || rep1 = rep2 then err else
- Some (Record_representation (rep2 = Record_float))
+ Option.map (fun rec_err -> Record_mismatch rec_err)
+ (compare_records_with_representation ~loc env
+ decl1.type_params decl2.type_params 1
+ labels1 labels2
+ rep1 rep2)
| (Type_open, Type_open) -> None
| (_, _) -> Some Kind
in
(* If attempt to assign a non-immediate type (e.g. string) to a type that
* must be immediate, then we error *)
let err =
- if abstr &&
- not decl1.type_immediate &&
- decl2.type_immediate then
- Some Immediate
- else None
+ if not abstr then
+ None
+ else
+ match
+ Type_immediacy.coerce decl1.type_immediate ~as_:decl2.type_immediate
+ with
+ | Ok () -> None
+ | Error violation -> Some (Immediate violation)
in
if err <> None then err else
let need_variance =
let extension_constructors ~loc env ~mark id ext1 ext2 =
if mark then begin
let usage =
- if ext1.ext_private = Private || ext2.ext_private = Public
- then Env.Positive else Env.Privatize
+ if ext2.ext_private = Public then Env.Positive
+ else Env.Privatize
in
- Env.mark_extension_used usage ext1 (Ident.name id)
+ Env.mark_extension_used usage (Ident.name id) ext1
end;
let ty1 =
Btype.newgenty (Tconstr(ext1.ext_type_path, ext1.ext_type_params, ref Mnil))
in
if not (Ctype.equal env true (ty1 :: ext1.ext_type_params)
(ty2 :: ext2.ext_type_params))
- then Some (Field_type id) else
- let r =
- match ext1.ext_ret_type, ext2.ext_ret_type with
- | Some r1, Some r2 ->
- if Ctype.equal env true [r1] [r2] then
- compare_constructor_arguments ~loc env id [r1] [r2]
- ext1.ext_args ext2.ext_args
- else Some (Field_type id)
- | Some _, None | None, Some _ ->
- Some (Field_type id)
- | None, None ->
- compare_constructor_arguments ~loc env id
- ext1.ext_type_params ext2.ext_type_params
- ext1.ext_args ext2.ext_args
- in
- if r <> None then r else
- match ext1.ext_private, ext2.ext_private with
- | Private, Public -> Some Privacy
- | _, _ -> None
+ then Some (Constructor_mismatch (id, ext1, ext2, Type))
+ else
+ let r =
+ compare_constructors ~loc env ext1.ext_type_params ext2.ext_type_params
+ ext1.ext_ret_type ext2.ext_ret_type
+ ext1.ext_args ext2.ext_args
+ in
+ match r with
+ | Some r -> Some (Constructor_mismatch (id, ext1, ext2, r))
+ | None -> match ext1.ext_private, ext2.ext_private with
+ Private, Public -> Some Constructor_privacy
+ | _, _ -> None
exception Dont_match
+type position = Ctype.Unification_trace.position = First | Second
+
+type label_mismatch =
+ | Type
+ | Mutability of position
+
+type record_mismatch =
+ | Label_mismatch of label_declaration * label_declaration * label_mismatch
+ | Label_names of int * Ident.t * Ident.t
+ | Label_missing of position * Ident.t
+ | Unboxed_float_representation of position
+
+type constructor_mismatch =
+ | Type
+ | Arity
+ | Inline_record of record_mismatch
+ | Kind of position
+ | Explicit_return_type of position
+
+type variant_mismatch =
+ | Constructor_mismatch of constructor_declaration
+ * constructor_declaration
+ * constructor_mismatch
+ | Constructor_names of int * Ident.t * Ident.t
+ | Constructor_missing of position * Ident.t
+
+type extension_constructor_mismatch =
+ | Constructor_privacy
+ | Constructor_mismatch of Ident.t
+ * extension_constructor
+ * extension_constructor
+ * constructor_mismatch
+
type type_mismatch =
- Arity
+ | Arity
| Privacy
| Kind
| Constraint
| Manifest
| Variance
- | Field_type of Ident.t
- | Field_mutable of Ident.t
- | Field_arity of Ident.t
- | Field_names of int * Ident.t * Ident.t
- | Field_missing of bool * Ident.t
- | Record_representation of bool
- | Unboxed_representation of bool
- | Immediate
+ | Record_mismatch of record_mismatch
+ | Variant_mismatch of variant_mismatch
+ | Unboxed_representation of position
+ | Immediate of Type_immediacy.Violation.t
val value_descriptions:
loc:Location.t -> Env.t -> string ->
val extension_constructors:
loc:Location.t -> Env.t -> mark:bool -> Ident.t ->
- extension_constructor -> extension_constructor -> type_mismatch option
+ extension_constructor -> extension_constructor ->
+ extension_constructor_mismatch option
(*
val class_types:
Env.t -> class_type -> class_type -> bool
val report_type_mismatch:
string -> string -> string -> Format.formatter -> type_mismatch -> unit
+val report_extension_constructor_mismatch: string -> string -> string ->
+ Format.formatter -> extension_constructor_mismatch -> unit
| Type_declarations of Ident.t * type_declaration
* type_declaration * Includecore.type_mismatch
| Extension_constructors of Ident.t * extension_constructor
- * extension_constructor * Includecore.type_mismatch
+ * extension_constructor * Includecore.extension_constructor_mismatch
| Module_types of module_type * module_type
| Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
| Modtype_permutation of Types.module_type * Typedtree.module_coercion
| Invalid_module_alias of Path.t
type pos =
- Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+ | Module of Ident.t
+ | Modtype of Ident.t
+ | Arg of functor_parameter
+ | Body of functor_parameter
type error = pos list * Env.t * symptom
exception Error of error list
+exception Apply_error of Location.t * Path.t * Path.t * error list
type mark =
| Mark_both
try_modtypes2 ~loc env ~mark cxt mty1 (Subst.modtype Keep subst mty2)
| (Mty_signature sig1, Mty_signature sig2) ->
signatures ~loc env ~mark cxt subst sig1 sig2
- | (Mty_functor(param1, None, res1), Mty_functor(_param2, None, res2)) ->
+ | (Mty_functor(Unit, res1), Mty_functor(Unit, res2)) ->
begin
- match modtypes ~loc env ~mark (Body param1::cxt) subst res1 res2 with
+ match modtypes ~loc env ~mark (Body Unit::cxt) subst res1 res2 with
| Tcoerce_none -> Tcoerce_none
| cc -> Tcoerce_functor (Tcoerce_none, cc)
end
- | (Mty_functor(param1, Some arg1, res1),
- Mty_functor(param2, Some arg2, res2)) ->
+ | (Mty_functor(Named (param1, arg1) as arg, res1),
+ Mty_functor(Named (param2, arg2), res2)) ->
let arg2' = Subst.modtype Keep subst arg2 in
let cc_arg =
modtypes ~loc env ~mark:(negate_mark mark)
- (Arg param1::cxt) Subst.identity arg2' arg1
+ (Arg arg::cxt) Subst.identity arg2' arg1
in
- let cc_res =
- modtypes ~loc (Env.add_module param1 Mp_present arg2' env) ~mark
- (Body param1::cxt)
- (Subst.add_module param2 (Path.Pident param1) subst)
- res1 res2
+ let env, subst =
+ match param1, param2 with
+ | Some p1, Some p2 ->
+ Env.add_module p1 Mp_present arg2' env,
+ Subst.add_module p2 (Path.Pident p1) subst
+ | None, Some p2 ->
+ Env.add_module p2 Mp_present arg2' env, subst
+ | Some p1, None ->
+ Env.add_module p1 Mp_present arg2' env, subst
+ | None, None ->
+ env, subst
in
+ let cc_res = modtypes ~loc env ~mark (Body arg::cxt) subst res1 res2 in
begin match (cc_arg, cc_res) with
(Tcoerce_none, Tcoerce_none) -> Tcoerce_none
| _ -> Tcoerce_functor(cc_arg, cc_res)
(Mtype.strengthen ~aliasable env mty1 path1) mty2)
let () =
- Env.check_modtype_inclusion := (fun ~loc a b c d ->
- try (check_modtype_inclusion ~loc a b c d : unit)
- with Error _ -> raise Not_found)
+ Env.check_functor_application :=
+ (fun ~errors ~loc env mty1 path1 mty2 path2 ->
+ try
+ check_modtype_inclusion ~loc env mty1 path1 mty2
+ with Error errs ->
+ if errors then
+ raise (Apply_error(loc, path1, path2, errs))
+ else
+ raise Not_found)
(* Check that an implementation of a compilation unit meets its
interface. *)
| Sig_module (id, _, md,_,_) -> find env (Module id :: ctx) q md.md_type
| _ -> raise Not_found
end
- | Mty_functor(x,Some mt,_), InArg :: q -> find env (Arg x :: ctx) q mt
- | Mty_functor(x,_,mt), InBody :: q -> find env (Body x :: ctx) q mt
+ | Mty_functor(Named (_,mt) as arg,_), InArg :: q ->
+ find env (Arg arg :: ctx) q mt
+ | Mty_functor(arg, mt), InBody :: q ->
+ find env (Body arg :: ctx) q mt
| _ -> raise Not_found
let find env path mt = find env [] path mt
| Body x :: rem ->
fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
| Arg x :: rem ->
- fprintf ppf "functor (%a : %a) -> ..." Printtyp.ident x context_mty rem
+ fprintf ppf "functor (%s : %a) -> ..." (argname x) context_mty rem
| [] ->
fprintf ppf "<here>"
and context_mty ppf = function
Body x :: rem ->
fprintf ppf "(%s)%a" (argname x) args rem
| Arg x :: rem ->
- fprintf ppf "(%a :@ %a) : ..." Printtyp.ident x context_mty rem
+ fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem
| cxt ->
fprintf ppf " :@ %a" context_mty cxt
-and argname x =
- let s = Ident.name x in
- if s = "*" then "" else s
+and argname = function
+ | Unit -> ""
+ | Named (None, _) -> "_"
+ | Named (Some id, _) -> Ident.name id
let alt_context ppf cxt =
if cxt = [] then () else
"is not included in"
!Oprint.out_sig_item
(Printtyp.tree_of_type_declaration id d2 Trec_first)
- show_locs (d1.type_loc, d2.type_loc)
(Includecore.report_type_mismatch
"the first" "the second" "declaration") err
+ show_locs (d1.type_loc, d2.type_loc)
| Extension_constructors(id, x1, x2, err) ->
- fprintf ppf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
+ fprintf ppf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a@]"
"Extension declarations do not match"
!Oprint.out_sig_item
(Printtyp.tree_of_extension_constructor id x1 Text_first)
"is not included in"
!Oprint.out_sig_item
(Printtyp.tree_of_extension_constructor id x2 Text_first)
- show_locs (x1.ext_loc, x2.ext_loc)
- (Includecore.report_type_mismatch
+ (Includecore.report_extension_constructor_mismatch
"the first" "the second" "declaration") err
+ show_locs (x1.ext_loc, x2.ext_loc)
| Module_types(mty1, mty2)->
fprintf ppf
"@[<hv 2>Modules do not match:@ \
let print_errs ppf = List.iter (include_err' ppf) in
Printtyp.Conflicts.reset();
fprintf ppf "@[<v>%a%a%t@]" print_errs errs include_err err
- Printtyp.Conflicts.print
+ Printtyp.Conflicts.print_explanations
+
+let report_apply_error p1 p2 ppf errs =
+ fprintf ppf "@[The type of %a does not match %a's parameter@ %a@]"
+ Printtyp.path p1 Printtyp.path p2 report_error errs
(* We could do a better job to split the individual error items
as sub-messages of the main interface mismatch on the whole unit. *)
Location.register_error_of_exn
(function
| Error err -> Some (Location.error_of_printer_file report_error err)
+ | Apply_error(loc, p1, p2, err) ->
+ Some (Location.error_of_printer ~loc (report_apply_error p1 p2) err)
| _ -> None
)
| Type_declarations of Ident.t * type_declaration
* type_declaration * Includecore.type_mismatch
| Extension_constructors of Ident.t * extension_constructor
- * extension_constructor * Includecore.type_mismatch
+ * extension_constructor * Includecore.extension_constructor_mismatch
| Module_types of module_type * module_type
| Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
| Modtype_permutation of Types.module_type * Typedtree.module_coercion
| Invalid_module_alias of Path.t
type pos =
- Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+ | Module of Ident.t
+ | Modtype of Ident.t
+ | Arg of functor_parameter
+ | Body of functor_parameter
type error = pos list * Env.t * symptom
exception Error of error list
match scrape env mty with
Mty_signature sg ->
Mty_signature(strengthen_sig ~aliasable env sg p)
- | Mty_functor(param, arg, res)
- when !Clflags.applicative_functors && Ident.name param <> "*" ->
- Mty_functor(param, arg,
+ | Mty_functor(Named (Some param, arg), res)
+ when !Clflags.applicative_functors ->
+ Mty_functor(Named (Some param, arg),
+ strengthen ~aliasable:false env res (Papply(p, Pident param)))
+ | Mty_functor(Named (None, arg), res)
+ when !Clflags.applicative_functors ->
+ let param = Ident.create_scoped ~scope:(Path.scope p) "Arg" in
+ Mty_functor(Named (Some param, arg),
strengthen ~aliasable:false env res (Papply(p, Pident param)))
| mty ->
mty
| Mty_alias _ -> Mp_absent, mty
| Mty_signature sg ->
pres, Mty_signature(make_aliases_absent_sig sg)
- | Mty_functor(param, arg, res) ->
+ | Mty_functor(arg, res) ->
let _, res = make_aliases_absent Mp_present res in
- pres, Mty_functor(param, arg, res)
+ pres, Mty_functor(arg, res)
| mty ->
pres, mty
| Mty_signature sg ->
let mty = Mty_signature(nondep_sig env va ids sg) in
pres, mty
- | Mty_functor(param, arg, res) ->
+ | Mty_functor(Unit, res) ->
+ pres, Mty_functor(Unit, nondep_mty env va ids res)
+ | Mty_functor(Named (param, arg), res) ->
let var_inv =
match va with Co -> Contra | Contra -> Co | Strict -> Strict in
+ let res_env =
+ match param with
+ | None -> env
+ | Some param -> Env.add_module ~arg:true param Mp_present arg env
+ in
let mty =
- Mty_functor(param, Misc.may_map (nondep_mty env var_inv ids) arg,
- nondep_mty
- (Env.add_module ~arg:true param Mp_present
- (Btype.default_mty arg) env) va ids res)
+ Mty_functor(Named (param, nondep_mty env var_inv ids arg),
+ nondep_mty res_env va ids res)
in
pres, mty
List.map (nondep_sig_item env va ids) sg
and nondep_modtype_decl env ids mtd =
- {mtd with mtd_type = Misc.may_map (nondep_mty env Strict ids) mtd.mtd_type}
+ {mtd with mtd_type = Option.map (nondep_mty env Strict ids) mtd.mtd_type}
let nondep_supertype env ids = nondep_mty env Co ids
let nondep_sig_item env ids = nondep_sig_item env Co ids
end
| Mty_signature sg ->
contains_type_sig env sg
- | Mty_functor (_, _, body) ->
+ | Mty_functor (_, body) ->
contains_type env body
| Mty_alias _ ->
()
fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
print_out_type arg
+let out_label = ref print_out_label
+
let out_type = ref print_out_type
(* Class types *)
let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension")
-let rec print_out_functor funct ppf =
- function
- Omty_functor (_, None, mty_res) ->
- if funct then fprintf ppf "() %a" (print_out_functor true) mty_res
- else fprintf ppf "functor@ () %a" (print_out_functor true) mty_res
- | Omty_functor (name, Some mty_arg, mty_res) -> begin
- match name, funct with
- | "_", true ->
- fprintf ppf "->@ %a ->@ %a"
- print_out_module_type mty_arg (print_out_functor false) mty_res
- | "_", false ->
- fprintf ppf "%a ->@ %a"
- print_out_module_type mty_arg (print_out_functor false) mty_res
- | name, true ->
- fprintf ppf "(%s : %a) %a" name
- print_out_module_type mty_arg (print_out_functor true) mty_res
- | name, false ->
- fprintf ppf "functor@ (%s : %a) %a" name
- print_out_module_type mty_arg (print_out_functor true) mty_res
- end
- | m ->
- if funct then fprintf ppf "->@ %a" print_out_module_type m
- else print_out_module_type ppf m
+(* For anonymous functor arguments, the logic to choose between
+ the long-form
+ functor (_ : S) -> ...
+ and the short-form
+ S -> ...
+ is as follows: if we are already printing long-form functor arguments,
+ we use the long form unless all remaining functor arguments can use
+ the short form. (Otherwise use the short form.)
+
+ For example,
+ functor (X : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end
+ will get printed as
+ functor (X : S1) (_ : S2) (Y : S3) -> S4 -> S5 -> sig end
+
+ but
+ functor (_ : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end
+ gets printed as
+ S1 -> S2 -> functor (Y : S3) -> S4 -> S5 -> sig end
+*)
+
+(* take a module type that may be a functor type,
+ and return the longest prefix list of arguments
+ that should be printed in long form. *)
+let collect_functor_arguments mty =
+ let rec collect_args acc = function
+ | Omty_functor (param, mty_res) ->
+ collect_args (param :: acc) mty_res
+ | non_functor -> (acc, non_functor)
+ in
+ let rec uncollect_anonymous_suffix acc rest = match acc with
+ | Some (None, mty_arg) :: acc ->
+ uncollect_anonymous_suffix acc
+ (Omty_functor (Some (None, mty_arg), rest))
+ | _ :: _ | [] ->
+ (acc, rest)
+ in
+ let (acc, non_functor) = collect_args [] mty in
+ let (acc, rest) = uncollect_anonymous_suffix acc non_functor in
+ (List.rev acc, rest)
-and print_out_module_type ppf =
+let rec print_out_module_type ppf mty =
+ print_out_functor ppf mty
+and print_out_functor ppf = function
+ | Omty_functor _ as t ->
+ let rec print_functor ppf = function
+ | Omty_functor (Some (None, mty_arg), mty_res) ->
+ fprintf ppf "%a ->@ %a"
+ print_simple_out_module_type mty_arg
+ print_functor mty_res
+ | Omty_functor _ as non_anonymous_functor ->
+ let (args, rest) = collect_functor_arguments non_anonymous_functor in
+ let print_arg ppf = function
+ | None ->
+ fprintf ppf "()"
+ | Some (param, mty) ->
+ fprintf ppf "(%s : %a)"
+ (Option.value param ~default:"_")
+ print_out_module_type mty
+ in
+ fprintf ppf "@[<2>functor@ %a@]@ ->@ %a"
+ (pp_print_list ~pp_sep:pp_print_space print_arg) args
+ print_functor rest
+ | non_functor ->
+ print_simple_out_module_type ppf non_functor
+ in
+ fprintf ppf "@[<2>%a@]" print_functor t
+ | t -> print_simple_out_module_type ppf t
+and print_simple_out_module_type ppf =
function
Omty_abstract -> ()
- | Omty_functor _ as t ->
- fprintf ppf "@[<2>%a@]" (print_out_functor false) t
| Omty_ident id -> fprintf ppf "%a" print_ident id
| Omty_signature sg ->
- fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" !out_signature sg
+ begin match sg with
+ | [] -> fprintf ppf "sig end"
+ | sg ->
+ fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" print_out_signature sg
+ end
| Omty_alias id -> fprintf ppf "(module %a)" print_ident id
+ | Omty_functor _ as non_simple ->
+ fprintf ppf "(%a)" print_out_module_type non_simple
and print_out_signature ppf =
function
[] -> ()
| Asttypes.Public -> ()
in
let print_immediate ppf =
- if td.otype_immediate then fprintf ppf " [%@%@immediate]" else ()
+ match td.otype_immediate with
+ | Unknown -> ()
+ | Always -> fprintf ppf " [%@%@immediate]"
+ | Always_on_64bits -> fprintf ppf " [%@%@immediate64]"
in
let print_unboxed ppf =
if td.otype_unboxed then fprintf ppf " [%@%@unboxed]" else ()
(print_list print_out_constr (fun ppf -> fprintf ppf "@ | "))
te.otyext_constructors
+let out_constr = ref print_out_constr
let _ = out_module_type := print_out_module_type
let _ = out_signature := print_out_signature
let _ = out_sig_item := print_out_sig_item
val out_ident : (formatter -> out_ident -> unit) ref
val out_value : (formatter -> out_value -> unit) ref
+val out_label : (formatter -> string * bool * out_type -> unit) ref
val out_type : (formatter -> out_type -> unit) ref
+val out_constr :
+ (formatter -> string * out_type list * out_type option -> unit) ref
val out_class_type : (formatter -> out_class_type -> unit) ref
val out_module_type : (formatter -> out_module_type -> unit) ref
val out_sig_item : (formatter -> out_sig_item -> unit) ref
type out_module_type =
| Omty_abstract
- | Omty_functor of string * out_module_type option * out_module_type
+ | Omty_functor of (string option * out_module_type) option * out_module_type
| Omty_ident of out_ident
| Omty_signature of out_sig_item list
| Omty_alias of out_ident
otype_params: (string * (bool * bool)) list;
otype_type: out_type;
otype_private: Asttypes.private_flag;
- otype_immediate: bool;
+ otype_immediate: Type_immediacy.t;
otype_unboxed: bool;
otype_cstrs: (out_type * out_type) list }
and out_extension_constructor =
let omega_list l = List.map (fun _ -> omega) l
-let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty
+module Pattern_head : sig
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ (* the row of the type may evolve if [close_variant] is called,
+ hence the (unit -> ...) delay *)
+ | Array of int
+ | Lazy
+
+ type t
+
+ val desc : t -> desc
+ val env : t -> Env.t
+ val loc : t -> Location.t
+ val typ : t -> Types.type_expr
+
+ (** [deconstruct p] returns the head of [p] and the list of sub patterns.
+
+ @raises [Invalid_arg _] if [p] is an or- or an exception-pattern. *)
+ val deconstruct : pattern -> t * pattern list
+
+ (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+ val to_omega_pattern : t -> pattern
+
+ val make
+ : loc:Location.t
+ -> typ:Types.type_expr
+ -> env:Env.t
+ -> desc
+ -> t
+
+ val omega : t
+
+end = struct
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label;
+ has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row: unit -> row_desc; }
+ | Array of int
+ | Lazy
+
+ type t = {
+ desc: desc;
+ typ : Types.type_expr;
+ loc : Location.t;
+ env : Env.t;
+ attributes : attributes;
+ }
+
+ let desc { desc } = desc
+ let env { env } = env
+ let loc { loc } = loc
+ let typ { typ } = typ
+
+ let deconstruct q =
+ let rec deconstruct_desc = function
+ | Tpat_any
+ | Tpat_var _ -> Any, []
+ | Tpat_constant c -> Constant c, []
+ | Tpat_alias (p,_,_) -> deconstruct_desc p.pat_desc
+ | Tpat_tuple args ->
+ Tuple (List.length args), args
+ | Tpat_construct (_, c, args) ->
+ Construct c, args
+ | Tpat_variant (tag, arg, cstr_row) ->
+ let has_arg, pats =
+ match arg with
+ | None -> false, []
+ | Some a -> true, [a]
+ in
+ let type_row () =
+ match Ctype.expand_head q.pat_env q.pat_type with
+ | {desc = Tvariant type_row} -> Btype.row_repr type_row
+ | _ -> assert false
+ in
+ Variant {tag; has_arg; cstr_row; type_row}, pats
+ | Tpat_array args ->
+ Array (List.length args), args
+ | Tpat_record (largs, _) ->
+ let lbls = List.map (fun (_,lbl,_) -> lbl) largs in
+ let pats = List.map (fun (_,_,pat) -> pat) largs in
+ Record lbls, pats
+ | Tpat_lazy p ->
+ Lazy, [p]
+ | Tpat_or _ -> invalid_arg "Parmatch.Pattern_head.deconstruct: (P | Q)"
+ | Tpat_exception _ ->
+ invalid_arg "Parmatch.Pattern_head.deconstruct: (exception P)"
+ in
+ let desc, pats = deconstruct_desc q.pat_desc in
+ { desc; typ = q.pat_type; loc = q.pat_loc;
+ env = q.pat_env; attributes = q.pat_attributes }, pats
+
+ let to_omega_pattern t =
+ let pat_desc =
+ match t.desc with
+ | Any -> Tpat_any
+ | Lazy -> Tpat_lazy omega
+ | Constant c -> Tpat_constant c
+ | Tuple n -> Tpat_tuple (omegas n)
+ | Array n -> Tpat_array (omegas n)
+ | Construct c ->
+ let lid_loc = Location.mkloc (Longident.Lident c.cstr_name) t.loc in
+ Tpat_construct (lid_loc, c, omegas c.cstr_arity)
+ | Variant { tag; has_arg; cstr_row } ->
+ let arg_opt = if has_arg then Some omega else None in
+ Tpat_variant (tag, arg_opt, cstr_row)
+ | Record lbls ->
+ let lst =
+ List.map (fun lbl ->
+ let lid_loc =
+ Location.mkloc (Longident.Lident lbl.lbl_name) t.loc
+ in
+ (lid_loc, lbl, omega)
+ ) lbls
+ in
+ Tpat_record (lst, Closed)
+ in
+ { pat_desc; pat_type = t.typ; pat_loc = t.loc; pat_extra = [];
+ pat_env = t.env; pat_attributes = t.attributes }
+
+ let make ~loc ~typ ~env desc =
+ { desc; loc; typ; env; attributes = [] }
+
+ let omega =
+ { desc = Any
+ ; loc = Location.none
+ ; typ = Ctype.none
+ ; env = Env.empty
+ ; attributes = []
+ }
+end
+
+(*
+ Normalize a pattern ->
+ all arguments are omega (simple pattern) and no more variables
+*)
+
+let normalize_pat p = Pattern_head.(to_omega_pattern @@ fst @@ deconstruct p)
(*******************)
(* Coherence check *)
*)
let all_coherent column =
let coherent_heads hp1 hp2 =
- match hp1.pat_desc, hp2.pat_desc with
- | (Tpat_var _ | Tpat_alias _ | Tpat_or _), _
- | _, (Tpat_var _ | Tpat_alias _ | Tpat_or _) ->
- assert false
- | Tpat_construct (_, c, _), Tpat_construct (_, c', _) ->
+ match Pattern_head.desc hp1, Pattern_head.desc hp2 with
+ | Construct c, Construct c' ->
c.cstr_consts = c'.cstr_consts
&& c.cstr_nonconsts = c'.cstr_nonconsts
- | Tpat_constant c1, Tpat_constant c2 -> begin
+ | Constant c1, Constant c2 -> begin
match c1, c2 with
| Const_char _, Const_char _
| Const_int _, Const_int _
| Const_float _
| Const_string _), _ -> false
end
- | Tpat_tuple l1, Tpat_tuple l2 -> List.length l1 = List.length l2
- | Tpat_record ((_, lbl1, _) :: _, _), Tpat_record ((_, lbl2, _) :: _, _) ->
+ | Tuple l1, Tuple l2 -> l1 = l2
+ | Record (lbl1 :: _), Record (lbl2 :: _) ->
Array.length lbl1.lbl_all = Array.length lbl2.lbl_all
- | Tpat_any, _
- | _, Tpat_any
- | Tpat_record ([], _), Tpat_record ([], _)
- | Tpat_variant _, Tpat_variant _
- | Tpat_array _, Tpat_array _
- | Tpat_lazy _, Tpat_lazy _ -> true
+ | Any, _
+ | _, Any
+ | Record [], Record []
+ | Variant _, Variant _
+ | Array _, Array _
+ | Lazy, Lazy -> true
| _, _ -> false
in
match
List.find (fun head_pat ->
- match head_pat.pat_desc with
- | Tpat_var _ | Tpat_alias _ | Tpat_or _ -> assert false
- | Tpat_any -> false
+ match Pattern_head.desc head_pat with
+ | Any -> false
| _ -> true
) column
with
List.for_all (coherent_heads discr_pat) column
let first_column simplified_matrix =
- List.map fst simplified_matrix
+ List.map (fun ((head, _args), _rest) -> head) simplified_matrix
(***********************)
(* Compatibility check *)
let is_absent tag row = Btype.row_field tag !row = Rabsent
-let is_absent_pat p = match p.pat_desc with
-| Tpat_variant (tag, _, row) -> is_absent tag row
-| _ -> false
+let is_absent_pat d =
+ match Pattern_head.desc d with
+ | Variant { tag; cstr_row; _ } -> is_absent tag cstr_row
+ | _ -> false
let const_compare x y =
match x,y with
(****************************)
(* Check top matching *)
-let simple_match p1 p2 =
- match p1.pat_desc, p2.pat_desc with
- | Tpat_construct(_, c1, _), Tpat_construct(_, c2, _) ->
+let simple_match d h =
+ match Pattern_head.desc d, Pattern_head.desc h with
+ | Construct c1, Construct c2 ->
Types.equal_tag c1.cstr_tag c2.cstr_tag
- | Tpat_variant(l1, _, _), Tpat_variant(l2, _, _) ->
- l1 = l2
- | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
- | Tpat_lazy _, Tpat_lazy _ -> true
- | Tpat_record _ , Tpat_record _ -> true
- | Tpat_tuple p1s, Tpat_tuple p2s
- | Tpat_array p1s, Tpat_array p2s -> List.length p1s = List.length p2s
- | _, (Tpat_any | Tpat_var(_)) -> true
+ | Variant { tag = t1; _ }, Variant { tag = t2 } ->
+ t1 = t2
+ | Constant c1, Constant c2 -> const_compare c1 c2 = 0
+ | Lazy, Lazy -> true
+ | Record _, Record _ -> true
+ | Tuple len1, Tuple len2
+ | Array len1, Array len2 -> len1 = len2
+ | _, Any -> true
| _, _ -> false
-
(* extract record fields as a whole *)
-let record_arg p = match p.pat_desc with
-| Tpat_any -> []
-| Tpat_record (args,_) -> args
+let record_arg ph = match Pattern_head.desc ph with
+| Any -> []
+| Record args -> args
| _ -> fatal_error "Parmatch.as_record"
-(* Raise Not_found when pos is not present in arg *)
-let get_field pos arg =
- let _,_, p = List.find (fun (_,lbl,_) -> pos = lbl.lbl_pos) arg in
- p
-
-let extract_fields omegas arg =
- List.map
- (fun (_,lbl,_) ->
- try
- get_field lbl.lbl_pos arg
- with Not_found -> omega)
- omegas
+let extract_fields lbls arg =
+ let get_field pos arg =
+ match List.find (fun (lbl,_) -> pos = lbl.lbl_pos) arg with
+ | _, p -> p
+ | exception Not_found -> omega
+ in
+ List.map (fun lbl -> get_field lbl.lbl_pos arg) lbls
(* Build argument list when p2 >= p1, where p1 is a simple pattern *)
-let rec simple_match_args p1 p2 = match p2.pat_desc with
-| Tpat_alias (p2,_,_) -> simple_match_args p1 p2
-| Tpat_construct(_, _, args) -> args
-| Tpat_variant(_, Some arg, _) -> [arg]
-| Tpat_tuple(args) -> args
-| Tpat_record(args,_) -> extract_fields (record_arg p1) args
-| Tpat_array(args) -> args
-| Tpat_lazy arg -> [arg]
-| (Tpat_any | Tpat_var(_)) ->
- begin match p1.pat_desc with
- Tpat_construct(_, _,args) -> omega_list args
- | Tpat_variant(_, Some _, _) -> [omega]
- | Tpat_tuple(args) -> omega_list args
- | Tpat_record(args,_) -> omega_list args
- | Tpat_array(args) -> omega_list args
- | Tpat_lazy _ -> [omega]
- | _ -> []
+let simple_match_args discr head args = match Pattern_head.desc head with
+| Constant _ -> []
+| Construct _
+| Variant _
+| Tuple _
+| Array _
+| Lazy -> args
+| Record lbls -> extract_fields (record_arg discr) (List.combine lbls args)
+| Any ->
+ begin match Pattern_head.desc discr with
+ | Construct cstr -> omegas cstr.cstr_arity
+ | Variant { has_arg = true }
+ | Lazy -> [omega]
+ | Record lbls -> omega_list lbls
+ | Array len
+ | Tuple len -> omegas len
+ | Variant { has_arg = false }
+ | Any
+ | Constant _ -> []
end
-| _ -> []
-
-(*
- Normalize a pattern ->
- all arguments are omega (simple pattern) and no more variables
-*)
-
-let rec normalize_pat q = match q.pat_desc with
- | Tpat_any | Tpat_constant _ -> q
- | Tpat_var _ -> make_pat Tpat_any q.pat_type q.pat_env
- | Tpat_alias (p,_,_) -> normalize_pat p
- | Tpat_tuple (args) ->
- make_pat (Tpat_tuple (omega_list args)) q.pat_type q.pat_env
- | Tpat_construct (lid, c,args) ->
- make_pat
- (Tpat_construct (lid, c,omega_list args))
- q.pat_type q.pat_env
- | Tpat_variant (l, arg, row) ->
- make_pat (Tpat_variant (l, may_map (fun _ -> omega) arg, row))
- q.pat_type q.pat_env
- | Tpat_array (args) ->
- make_pat (Tpat_array (omega_list args)) q.pat_type q.pat_env
- | Tpat_record (largs, closed) ->
- make_pat
- (Tpat_record (List.map (fun (lid,lbl,_) ->
- lid, lbl,omega) largs, closed))
- q.pat_type q.pat_env
- | Tpat_lazy _ ->
- make_pat (Tpat_lazy omega) q.pat_type q.pat_env
- | Tpat_or _
- | Tpat_exception _ -> fatal_error "Parmatch.normalize_pat"
(* Consider a pattern matrix whose first column has been simplified to contain
only _ or a head constructor
We build a normalized /discriminating/ pattern from a pattern [q] by folding
over the first column of the matrix, "refining" [q] as we go:
- - when we encounter a row starting with [Tpat_tuple] or [Tpat_lazy] then we
- can stop and return that pattern, as we cannot refine any further. Indeed,
+ - when we encounter a row starting with [Tuple] or [Lazy] then we
+ can stop and return that head, as we cannot refine any further. Indeed,
these constructors are alone in their signature, so they will subsume
- whatever other pattern we might find, as well as the pattern we're threading
+ whatever other head we might find, as well as the head we're threading
along.
- - when we find a [Tpat_record] then it is a bit more involved: it is also
- alone in its signature, however it might only be matching a subset of the
+ - when we find a [Record] then it is a bit more involved: it is also alone
+ in its signature, however it might only be matching a subset of the
record fields. We use these fields to refine our accumulator and keep going
as another row might match on different fields.
let discr_pat q pss =
let rec refine_pat acc = function
| [] -> acc
- | (head, _) :: rows ->
- match head.pat_desc with
- | Tpat_or _ | Tpat_var _ | Tpat_alias _ -> assert false
- | Tpat_any -> refine_pat acc rows
- | Tpat_tuple _ | Tpat_lazy _ -> normalize_pat head
- | Tpat_record (largs, closed) ->
+ | ((head, _), _) :: rows ->
+ match Pattern_head.desc head with
+ | Any -> refine_pat acc rows
+ | Tuple _ | Lazy -> head
+ | Record lbls ->
(* N.B. we could make this case "simpler" by refining the record case
using [all_record_args].
In which case we wouldn't need to fold over the first column for
records.
However it makes the witness we generate for the exhaustivity warning
less pretty. *)
- let new_omegas =
- List.fold_right
- (fun (lid, lbl,_) r ->
- try
- let _ = get_field lbl.lbl_pos r in
- r
- with Not_found ->
- (lid, lbl,omega)::r)
- largs (record_arg acc)
+ let fields =
+ List.fold_right (fun lbl r ->
+ if List.exists (fun l -> l.lbl_pos = lbl.lbl_pos) r then
+ r
+ else
+ lbl :: r
+ ) lbls (record_arg acc)
in
- let new_acc =
- make_pat (Tpat_record (new_omegas, closed)) head.pat_type head.pat_env
+ let d =
+ let open Pattern_head in
+ make ~loc:(loc head) ~typ:(typ head) ~env:(env head) (Record fields)
in
- refine_pat new_acc rows
+ refine_pat d rows
| _ -> acc
in
- let q = normalize_pat q in
- (* short-circuiting: clearly if we have anything other than [Tpat_record] or
- [Tpat_any] to start with, we're not going to be able refine at all. So
+ let q, _ = Pattern_head.deconstruct q in
+ match Pattern_head.desc q with
+ (* short-circuiting: clearly if we have anything other than [Record] or
+ [Any] to start with, we're not going to be able refine at all. So
there's no point going over the matrix. *)
- match q.pat_desc with
- | Tpat_any | Tpat_record _ -> refine_pat q pss
+ | Any | Record _ -> refine_pat q pss
| _ -> q
(*
| _,_ ->
fatal_error "Parmatch.read_args"
-let do_set_args erase_mutable q r = match q with
+let do_set_args ~erase_mutable q r = match q with
| {pat_desc = Tpat_tuple omegas} ->
let args,rest = read_args omegas r in
make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest
q::r (* case any is used in matching.ml *)
| _ -> fatal_error "Parmatch.set_args"
-let set_args q r = do_set_args false q r
-and set_args_erase_mutable q r = do_set_args true q r
+let set_args q r = do_set_args ~erase_mutable:false q r
+and set_args_erase_mutable q r = do_set_args ~erase_mutable:true q r
(* Given a matrix of non-empty rows
p1 :: r1...
p3 :: r3...
Simplify the first column [p1 p2 p3] by splitting all or-patterns.
- The result is a list of couples
- (simple pattern, rest of row)
- where a "simple pattern" starts with either the catch-all pattern omega (_)
- or a head constructor.
+ The result is a list of pairs
+ ((pattern head, arguments), rest of row)
For example,
x :: r1
(None as x) as y :: r3
(Some x | (None as x)) :: r4
becomes
- (_, r1)
- (Some _, r2)
- (None, r3)
- (Some x, r4)
- (None, r4)
+ (( _ , [ ] ), r1)
+ (( Some, [_] ), r2)
+ (( None, [ ] ), r3)
+ (( Some, [x] ), r4)
+ (( None, [ ] ), r4)
*)
let simplify_head_pat ~add_column p ps k =
let rec simplify_head_pat p ps k =
match p.pat_desc with
- | Tpat_alias (p,_,_) -> simplify_head_pat p ps k
- | Tpat_var (_,_) -> add_column omega ps k
+ | Tpat_alias (p,_,_) ->
+ (* We have to handle aliases here, because there can be or-patterns
+ underneath, that [Pattern_head.deconstruct] won't handle. *)
+ simplify_head_pat p ps k
| Tpat_or (p1,p2,_) -> simplify_head_pat p1 ps (simplify_head_pat p2 ps k)
- | _ -> add_column p ps k
+ | _ -> add_column (Pattern_head.deconstruct p) ps k
in simplify_head_pat p ps k
let rec simplify_first_col = function
simplify_head_pat ~add_column p ps (simplify_first_col rows)
-(* Builds the specialized matrix of [pss] according to pattern [q].
+(* Builds the specialized matrix of [pss] according to the discriminating
+ pattern head [d].
See section 3.1 of http://moscova.inria.fr/~maranget/papers/warn/warn.pdf
NOTES:
- - expects [pss] to be a "simplified matrix", cf. [simplify_first_col]
- - [q] was produced by [discr_pat]
- we are polymorphic on the type of matrices we work on, in particular a row
might not simply be a [pattern list]. That's why we have the [extend_row]
parameter.
*)
-let build_specialized_submatrix ~extend_row q pss =
+let build_specialized_submatrix ~extend_row discr pss =
let rec filter_rec = function
- | ({pat_desc = (Tpat_alias _ | Tpat_or _ | Tpat_var _) }, _) :: _ ->
- assert false
- | (p, ps) :: pss ->
- if simple_match q p
- then extend_row (simple_match_args q p) ps :: filter_rec pss
+ | ((head, args), ps) :: pss ->
+ if simple_match discr head
+ then extend_row (simple_match_args discr head args) ps :: filter_rec pss
else filter_rec pss
| _ -> [] in
filter_rec pss
*)
type 'matrix specialized_matrices = {
default : 'matrix;
- constrs : (pattern * 'matrix) list;
+ constrs : (Pattern_head.t * 'matrix) list;
}
(* Consider a pattern matrix whose first column has been simplified
See the documentation of [build_specialized_submatrix] for an explanation of
the [extend_row] parameter.
*)
-let build_specialized_submatrices ~extend_row q rows =
- let extend_group discr p r rs =
- let r = extend_row (simple_match_args discr p) r in
+let build_specialized_submatrices ~extend_row discr rows =
+ let extend_group discr p args r rs =
+ let r = extend_row (simple_match_args discr p args) r in
(discr, r :: rs)
in
(* insert a row of head [p] and rest [r] into the right group *)
- let rec insert_constr p r = function
+ let rec insert_constr head args r = function
| [] ->
(* if no group matched this row, it has a head constructor that
was never seen before; add a new sub-matrix for this head *)
- [extend_group (normalize_pat p) p r []]
+ [extend_group head head args r []]
| (q0,rs) as bd::env ->
- if simple_match q0 p
- then extend_group q0 p r rs :: env
- else bd :: insert_constr p r env
+ if simple_match q0 head
+ then extend_group q0 head args r rs :: env
+ else bd :: insert_constr head args r env
in
(* insert a row of head omega into all groups *)
let insert_omega r env =
- List.map (fun (q0,rs) -> extend_group q0 omega r rs) env
+ List.map (fun (q0,rs) -> extend_group q0 Pattern_head.omega [] r rs) env
in
let rec form_groups constr_groups omega_tails = function
| [] -> (constr_groups, omega_tails)
- | ({pat_desc=(Tpat_var _|Tpat_alias _|Tpat_or _)},_)::_ -> assert false
- | ({pat_desc=Tpat_any}, tail) :: rest ->
- (* note that calling insert_omega here would be wrong
- as some groups may not have been formed yet, if the
- first row with this head pattern comes after in the list *)
- form_groups constr_groups (tail :: omega_tails) rest
- | (p,r) :: rest ->
- form_groups (insert_constr p r constr_groups) omega_tails rest
+ | ((head, args), tail) :: rest ->
+ match Pattern_head.desc head with
+ | Any ->
+ (* note that calling insert_omega here would be wrong
+ as some groups may not have been formed yet, if the
+ first row with this head pattern comes after in the list *)
+ form_groups constr_groups (tail :: omega_tails) rest
+ | _ ->
+ form_groups
+ (insert_constr head args tail constr_groups) omega_tails rest
in
let constr_groups, omega_tails =
let initial_constr_group =
- match q.pat_desc with
- | Tpat_record(_) | Tpat_tuple(_) | Tpat_lazy(_) ->
- (* [q] comes from [discr_pat], and in this case subsumes any of the
+ match Pattern_head.desc discr with
+ | Record _ | Tuple _ | Lazy ->
+ (* [discr] comes from [discr_pat], and in this case subsumes any of the
patterns we could find on the first column of [rows]. So it is better
to use it for our initial environment than any of the normalized
pattern we might obtain from the first column. *)
- [q,[]]
+ [discr,[]]
| _ -> []
in
form_groups initial_constr_group [] rows
| x::l -> x :: loop l
in
function
- | (_, []) -> (a, [])
+ | (_, []) -> (Pattern_head.deconstruct a, [])
| (first, row) -> (first, loop row)
-(* mark constructor lines for failure when they are incomplete
-
- Precondition: the input matrix has been simplified so that its
- first column only contains _ or head constructors. *)
+(* mark constructor lines for failure when they are incomplete *)
let mark_partial =
- List.map (function
- | ({pat_desc=(Tpat_var _|Tpat_alias _|Tpat_or _)},_) -> assert false
- | ({pat_desc = Tpat_any }, _) as ps -> ps
- | ps -> set_last zero ps
+ let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty in
+ List.map (fun ((hp, _), _ as ps) ->
+ match Pattern_head.desc hp with
+ | Any -> ps
+ | _ -> set_last zero ps
)
let close_variant env row =
row_closed = true; row_name = nm}))
end
-let row_of_pat pat =
- match Ctype.expand_head pat.pat_env pat.pat_type with
- {desc = Tvariant row} -> Btype.row_repr row
- | _ -> assert false
-
(*
Check whether the first column of env makes up a complete signature or
- not. We work on the discriminating patterns of each sub-matrix: they
- are simplified, and are not omega/Tpat_any.
+ not. We work on the discriminating pattern heads of each sub-matrix: they
+ are not omega/Any.
*)
let full_match closing env = match env with
-| ({pat_desc = (Tpat_any | Tpat_var _ | Tpat_alias _
- | Tpat_or _ | Tpat_exception _)},_) :: _ ->
- (* discriminating patterns are simplified *)
- assert false
| [] -> false
-| ({pat_desc = Tpat_construct(_,c,_)},_) :: _ ->
- if c.cstr_consts < 0 then false (* extensions *)
- else List.length env = c.cstr_consts + c.cstr_nonconsts
-| ({pat_desc = Tpat_variant _} as p,_) :: _ ->
- let fields =
- List.map
- (function ({pat_desc = Tpat_variant (tag, _, _)}, _) -> tag
- | _ -> assert false)
- env
- in
- let row = row_of_pat p in
- if closing && not (Btype.row_fixed row) then
- (* closing=true, we are considering the variant as closed *)
- List.for_all
- (fun (tag,f) ->
- match Btype.row_field_repr f with
- Rabsent | Reither(_, _, false, _) -> true
- | Reither (_, _, true, _)
- (* m=true, do not discard matched tags, rather warn *)
- | Rpresent _ -> List.mem tag fields)
- row.row_fields
- else
- row.row_closed &&
- List.for_all
- (fun (tag,f) ->
- Btype.row_field_repr f = Rabsent || List.mem tag fields)
- row.row_fields
-| ({pat_desc = Tpat_constant(Const_char _)},_) :: _ ->
- List.length env = 256
-| ({pat_desc = Tpat_constant(_)},_) :: _ -> false
-| ({pat_desc = Tpat_tuple(_)},_) :: _ -> true
-| ({pat_desc = Tpat_record(_)},_) :: _ -> true
-| ({pat_desc = Tpat_array(_)},_) :: _ -> false
-| ({pat_desc = Tpat_lazy(_)},_) :: _ -> true
+| (discr, _) :: _ ->
+ match Pattern_head.desc discr with
+ | Any -> assert false
+ | Construct { cstr_tag = Cstr_extension _ ; _ } -> false
+ | Construct c -> List.length env = c.cstr_consts + c.cstr_nonconsts
+ | Variant { type_row; _ } ->
+ let fields =
+ List.map
+ (fun (d, _) ->
+ match Pattern_head.desc d with
+ | Variant { tag } -> tag
+ | _ -> assert false)
+ env
+ in
+ let row = type_row () in
+ if closing && not (Btype.row_fixed row) then
+ (* closing=true, we are considering the variant as closed *)
+ List.for_all
+ (fun (tag,f) ->
+ match Btype.row_field_repr f with
+ Rabsent | Reither(_, _, false, _) -> true
+ | Reither (_, _, true, _)
+ (* m=true, do not discard matched tags, rather warn *)
+ | Rpresent _ -> List.mem tag fields)
+ row.row_fields
+ else
+ row.row_closed &&
+ List.for_all
+ (fun (tag,f) ->
+ Btype.row_field_repr f = Rabsent || List.mem tag fields)
+ row.row_fields
+ | Constant Const_char _ ->
+ List.length env = 256
+ | Constant _
+ | Array _ -> false
+ | Tuple _
+ | Record _
+ | Lazy -> true
(* Written as a non-fragile matching, PR#7451 originated from a fragile matching
below. *)
| Some ext -> begin match env with
| [] -> assert false
| (p,_)::_ ->
- begin match p.pat_desc with
- | Tpat_construct
- (_, {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)},_) ->
- let path = get_constructor_type_path p.pat_type p.pat_env in
- Path.same path ext
- | Tpat_construct
- (_, {cstr_tag=(Cstr_extension _)},_) -> false
- | Tpat_constant _|Tpat_tuple _|Tpat_variant _
- | Tpat_record _|Tpat_array _ | Tpat_lazy _
- -> false
- | Tpat_any|Tpat_var _|Tpat_alias _|Tpat_or _|Tpat_exception _
- -> assert false
+ begin match Pattern_head.desc p with
+ | Construct {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)} ->
+ let path =
+ get_constructor_type_path (Pattern_head.typ p) (Pattern_head.env p)
+ in
+ Path.same path ext
+ | Construct {cstr_tag=(Cstr_extension _)} -> false
+ | Constant _ | Tuple _ | Variant _ | Record _ | Array _ | Lazy -> false
+ | Any -> assert false
end
end
(* build an or-pattern from a constructor list *)
let pat_of_constrs ex_pat cstrs =
+ let ex_pat = Pattern_head.to_omega_pattern ex_pat in
if cstrs = [] then raise Empty else
orify_many (List.map (pat_of_constr ex_pat) cstrs)
(* Sends back a pattern that complements constructor tags all_tag *)
let complete_constrs p all_tags =
- let c =
- match p.pat_desc with Tpat_construct (_, c, _) -> c | _ -> assert false in
+ let c = match Pattern_head.desc p with Construct c -> c | _ -> assert false in
let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
- let constrs = get_variant_constructors p.pat_env c.cstr_res in
+ let constrs = get_variant_constructors (Pattern_head.env p) c.cstr_res in
let others =
List.filter
(fun cnstr -> ConstructorTagHashtbl.mem not_tags cnstr.cstr_tag)
const @ nonconst
let build_other_constrs env p =
- match p.pat_desc with
- Tpat_construct (_, {cstr_tag=Cstr_constant _|Cstr_block _}, _) ->
- let get_tag = function
- | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag
+ match Pattern_head.desc p with
+ | Construct { cstr_tag = Cstr_constant _ | Cstr_block _ } ->
+ let get_tag q =
+ match Pattern_head.desc q with
+ | Construct c -> c.cstr_tag
| _ -> fatal_error "Parmatch.get_tag" in
let all_tags = List.map (fun (p,_) -> get_tag p) env in
pat_of_constrs p (complete_constrs p all_tags)
| _ -> extra_pat
+let complete_constrs p all_tags =
+ (* This wrapper is here for [Matching], which (indirectly) calls this function
+ from [combine_constructor], and nowhere else.
+ So we know patterns have been fully simplified. *)
+ complete_constrs (fst @@ Pattern_head.deconstruct p) all_tags
+
(* Auxiliary for build_other *)
let build_other_constant proj make first next p env =
- let all = List.map (fun (p, _) -> proj p.pat_desc) env in
+ let all = List.map (fun (p, _) -> proj (Pattern_head.desc p)) env in
let rec try_const i =
if List.mem i all
then try_const (next i)
- else make_pat (make i) p.pat_type p.pat_env
+ else make_pat (make i) (Pattern_head.typ p) (Pattern_head.env p)
in try_const first
(*
let some_private_tag = "<some private tag>"
-let build_other ext env = match env with
-| ({pat_desc = Tpat_construct (lid, {cstr_tag=Cstr_extension _},_)},_) :: _ ->
- (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
- make_pat (Tpat_var (Ident.create_local "*extension*",
- {lid with txt="*extension*"})) Ctype.none Env.empty
-| ({pat_desc = Tpat_construct _} as p,_) :: _ ->
- begin match ext with
- | Some ext ->
- if Path.same ext (get_constructor_type_path p.pat_type p.pat_env) then
- extra_pat
- else
- build_other_constrs env p
- | _ ->
- build_other_constrs env p
- end
-| ({pat_desc = Tpat_variant (_,_,r)} as p,_) :: _ ->
- let tags =
- List.map
- (function ({pat_desc = Tpat_variant (tag, _, _)}, _) -> tag
+let build_other ext env =
+ match env with
+ | [] -> omega
+ | (d, _) :: _ ->
+ match Pattern_head.desc d with
+ | Construct { cstr_tag = Cstr_extension _ } ->
+ (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
+ make_pat
+ (Tpat_var (Ident.create_local "*extension*",
+ {txt="*extension*"; loc = Pattern_head.loc d}))
+ Ctype.none Env.empty
+ | Construct _ ->
+ begin match ext with
+ | Some ext ->
+ if Path.same ext
+ (get_constructor_type_path
+ (Pattern_head.typ d) (Pattern_head.env d))
+ then
+ extra_pat
+ else
+ build_other_constrs env d
+ | _ ->
+ build_other_constrs env d
+ end
+ | Variant { cstr_row; type_row } ->
+ let tags =
+ List.map
+ (fun (d, _) ->
+ match Pattern_head.desc d with
+ | Variant { tag } -> tag
| _ -> assert false)
- env
- in
- let row = row_of_pat p in
- let make_other_pat tag const =
- let arg = if const then None else Some omega in
- make_pat (Tpat_variant(tag, arg, r)) p.pat_type p.pat_env in
- begin match
- List.fold_left
- (fun others (tag,f) ->
- if List.mem tag tags then others else
- match Btype.row_field_repr f with
- Rabsent (* | Reither _ *) -> others
- (* This one is called after erasing pattern info *)
- | Reither (c, _, _, _) -> make_other_pat tag c :: others
- | Rpresent arg -> make_other_pat tag (arg = None) :: others)
- [] row.row_fields
- with
- [] ->
- let tag =
- if Btype.row_fixed row then some_private_tag else
- let rec mktag tag =
- if List.mem tag tags then mktag (tag ^ "'") else tag in
- mktag "AnyOtherTag"
- in make_other_pat tag true
- | pat::other_pats ->
- List.fold_left
- (fun p_res pat ->
- make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env)
- pat other_pats
- end
-| ({pat_desc = Tpat_constant(Const_char _)} as p,_) :: _ ->
- let all_chars =
- List.map
- (fun (p,_) -> match p.pat_desc with
- | Tpat_constant (Const_char c) -> c
- | _ -> assert false)
- env in
-
- let rec find_other i imax =
- if i > imax then raise Not_found
- else
- let ci = Char.chr i in
- if List.mem ci all_chars then
- find_other (i+1) imax
- else
- make_pat (Tpat_constant (Const_char ci)) p.pat_type p.pat_env in
- let rec try_chars = function
- | [] -> omega
- | (c1,c2) :: rest ->
- try
- find_other (Char.code c1) (Char.code c2)
- with
- | Not_found -> try_chars rest in
-
- try_chars
- [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ;
- ' ', '~' ; Char.chr 0 , Char.chr 255]
-
-| ({pat_desc=(Tpat_constant (Const_int _))} as p,_) :: _ ->
- build_other_constant
- (function Tpat_constant(Const_int i) -> i | _ -> assert false)
- (function i -> Tpat_constant(Const_int i))
- 0 succ p env
-| ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ ->
- build_other_constant
- (function Tpat_constant(Const_int32 i) -> i | _ -> assert false)
- (function i -> Tpat_constant(Const_int32 i))
- 0l Int32.succ p env
-| ({pat_desc=(Tpat_constant (Const_int64 _))} as p,_) :: _ ->
- build_other_constant
- (function Tpat_constant(Const_int64 i) -> i | _ -> assert false)
- (function i -> Tpat_constant(Const_int64 i))
- 0L Int64.succ p env
-| ({pat_desc=(Tpat_constant (Const_nativeint _))} as p,_) :: _ ->
- build_other_constant
- (function Tpat_constant(Const_nativeint i) -> i | _ -> assert false)
- (function i -> Tpat_constant(Const_nativeint i))
- 0n Nativeint.succ p env
-| ({pat_desc=(Tpat_constant (Const_string _))} as p,_) :: _ ->
- build_other_constant
- (function Tpat_constant(Const_string (s, _)) -> String.length s
+ env
+ in
+ let make_other_pat tag const =
+ let arg = if const then None else Some omega in
+ make_pat (Tpat_variant(tag, arg, cstr_row))
+ (Pattern_head.typ d) (Pattern_head.env d)
+ in
+ let row = type_row () in
+ begin match
+ List.fold_left
+ (fun others (tag,f) ->
+ if List.mem tag tags then others else
+ match Btype.row_field_repr f with
+ Rabsent (* | Reither _ *) -> others
+ (* This one is called after erasing pattern info *)
+ | Reither (c, _, _, _) -> make_other_pat tag c :: others
+ | Rpresent arg -> make_other_pat tag (arg = None) :: others)
+ [] row.row_fields
+ with
+ [] ->
+ let tag =
+ if Btype.row_fixed row then some_private_tag else
+ let rec mktag tag =
+ if List.mem tag tags then mktag (tag ^ "'") else tag in
+ mktag "AnyOtherTag"
+ in make_other_pat tag true
+ | pat::other_pats ->
+ List.fold_left
+ (fun p_res pat ->
+ make_pat (Tpat_or (pat, p_res, None))
+ (Pattern_head.typ d) (Pattern_head.env d))
+ pat other_pats
+ end
+ | Constant Const_char _ ->
+ let all_chars =
+ List.map
+ (fun (p,_) -> match Pattern_head.desc p with
+ | Constant (Const_char c) -> c
| _ -> assert false)
- (function i -> Tpat_constant(Const_string(String.make i '*', None)))
- 0 succ p env
-| ({pat_desc=(Tpat_constant (Const_float _))} as p,_) :: _ ->
- build_other_constant
- (function Tpat_constant(Const_float f) -> float_of_string f
+ env
+ in
+ let rec find_other i imax =
+ if i > imax then raise Not_found
+ else
+ let ci = Char.chr i in
+ if List.mem ci all_chars then
+ find_other (i+1) imax
+ else
+ make_pat (Tpat_constant (Const_char ci))
+ (Pattern_head.typ d) (Pattern_head.env d)
+ in
+ let rec try_chars = function
+ | [] -> omega
+ | (c1,c2) :: rest ->
+ try
+ find_other (Char.code c1) (Char.code c2)
+ with
+ | Not_found -> try_chars rest
+ in
+ try_chars
+ [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ;
+ ' ', '~' ; Char.chr 0 , Char.chr 255]
+ | Constant Const_int _ ->
+ build_other_constant
+ (function Constant(Const_int i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_int i))
+ 0 succ d env
+ | Constant Const_int32 _ ->
+ build_other_constant
+ (function Constant(Const_int32 i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_int32 i))
+ 0l Int32.succ d env
+ | Constant Const_int64 _ ->
+ build_other_constant
+ (function Constant(Const_int64 i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_int64 i))
+ 0L Int64.succ d env
+ | Constant Const_nativeint _ ->
+ build_other_constant
+ (function Constant(Const_nativeint i) -> i | _ -> assert false)
+ (function i -> Tpat_constant(Const_nativeint i))
+ 0n Nativeint.succ d env
+ | Constant Const_string _ ->
+ build_other_constant
+ (function Constant(Const_string (s, _)) -> String.length s
+ | _ -> assert false)
+ (function i -> Tpat_constant(Const_string(String.make i '*', None)))
+ 0 succ d env
+ | Constant Const_float _ ->
+ build_other_constant
+ (function Constant(Const_float f) -> float_of_string f
+ | _ -> assert false)
+ (function f -> Tpat_constant(Const_float (string_of_float f)))
+ 0.0 (fun f -> f +. 1.0) d env
+ | Array _ ->
+ let all_lengths =
+ List.map
+ (fun (p,_) -> match Pattern_head.desc p with
+ | Array len -> len
| _ -> assert false)
- (function f -> Tpat_constant(Const_float (string_of_float f)))
- 0.0 (fun f -> f +. 1.0) p env
-
-| ({pat_desc = Tpat_array _} as p,_)::_ ->
- let all_lengths =
- List.map
- (fun (p,_) -> match p.pat_desc with
- | Tpat_array args -> List.length args
- | _ -> assert false)
- env in
- let rec try_arrays l =
- if List.mem l all_lengths then try_arrays (l+1)
- else
- make_pat
- (Tpat_array (omegas l))
- p.pat_type p.pat_env in
- try_arrays 0
-| [] -> omega
-| _ -> omega
+ env in
+ let rec try_arrays l =
+ if List.mem l all_lengths then try_arrays (l+1)
+ else
+ make_pat
+ (Tpat_array (omegas l))
+ (Pattern_head.typ d) (Pattern_head.env d) in
+ try_arrays 0
+ | _ -> omega
let rec has_instance p = match p.pat_desc with
| Tpat_variant (l,_,r) when is_absent l r -> false
List.exists
(fun (p,pss) ->
not (is_absent_pat p) &&
- satisfiable pss (simple_match_args p omega @ qs))
+ satisfiable pss
+ (simple_match_args p Pattern_head.omega [] @ qs))
constrs
end
| {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> false
| q::qs ->
let pss = simplify_first_col pss in
- if not (all_coherent (q :: first_column pss)) then
+ let hq, qargs = Pattern_head.deconstruct q in
+ if not (all_coherent (hq :: first_column pss)) then
false
else begin
let q0 = discr_pat q pss in
satisfiable (build_specialized_submatrix ~extend_row:(@) q0 pss)
- (simple_match_args q0 q @ qs)
+ (simple_match_args q0 hq qargs @ qs)
end
(* While [satisfiable] only checks whether the last row of [pss + qs] is
else
let witnesses =
list_satisfying_vectors pss
- (simple_match_args p omega @ qs)
+ (simple_match_args p Pattern_head.omega [] @ qs)
in
+ let p = Pattern_head.to_omega_pattern p in
List.map (set_args p) witnesses
) constrs
)
in
if full_match false constrs then for_constrs () else
- begin match p.pat_desc with
- | Tpat_construct _ ->
+ begin match Pattern_head.desc p with
+ | Construct _ ->
(* activate this code for checking non-gadt constructors *)
wild default (build_other_constrs constrs p)
@ for_constrs ()
end
| {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> []
| q::qs ->
+ let hq, qargs = Pattern_head.deconstruct q in
let pss = simplify_first_col pss in
- if not (all_coherent (q :: first_column pss)) then
+ if not (all_coherent (hq :: first_column pss)) then
[]
else begin
let q0 = discr_pat q pss in
- List.map (set_args q0)
+ List.map (set_args (Pattern_head.to_omega_pattern q0))
(list_satisfying_vectors
(build_specialized_submatrix ~extend_row:(@) q0 pss)
- (simple_match_args q0 q @ qs))
+ (simple_match_args q0 hq qargs @ qs))
end
(******************************************)
in
do_match (remove_first_column pss) qs
| _ ->
- let q0 = normalize_pat q in
+ (* [q] is generated by us, it doesn't come from the source. So we know
+ it's not of the form [P as name].
+ Therefore there is no risk of [deconstruct] raising. *)
+ let q0, qargs = Pattern_head.deconstruct q in
let pss = simplify_first_col pss in
(* [pss] will (or won't) match [q0 :: qs] regardless of the coherence of
its first column. *)
do_match
(build_specialized_submatrix ~extend_row:(@) q0 pss)
- (simple_match_args q0 q @ qs)
+ (qargs @ qs)
type 'a exhaust_result =
| { default; constrs = [] } ->
(* first column of pss is made of variables only *)
begin match exhaust ext default (n-1) with
- | Witnesses r -> Witnesses (List.map (fun row -> q0::row) r)
+ | Witnesses r ->
+ let q0 = Pattern_head.to_omega_pattern q0 in
+ Witnesses (List.map (fun row -> q0::row) r)
| r -> r
end
| { default; constrs } ->
else
match
exhaust
- ext pss (List.length (simple_match_args p omega) + n - 1)
+ ext pss
+ (List.length (simple_match_args p Pattern_head.omega [])
+ + n - 1)
with
| Witnesses r ->
- Witnesses (List.map (fun row -> (set_args p row)) r)
+ let p = Pattern_head.to_omega_pattern p in
+ Witnesses (List.map (set_args p) r)
| r -> r in
let before = try_many try_non_omega constrs in
if
end
in
begin match constrs, tdefs with
- ({pat_desc=Tpat_variant _} as p,_):: _, Some env ->
- let row = row_of_pat p in
+ | [], _
+ | _, None -> ()
+ | (d, _) :: _, Some env ->
+ match Pattern_head.desc d with
+ | Variant { type_row; _ } ->
+ let row = type_row () in
if Btype.row_fixed row
|| pressure_variants None default then ()
else close_variant env row
- | _ -> ()
+ | _ -> ()
end;
ok
end
| _ ->
(* standard case, filter matrix *)
let pss = simplify_first_usefulness_col pss in
+ let huq, args = Pattern_head.deconstruct uq in
(* The handling of incoherent matrices is kept in line with
[satisfiable] *)
- if not (all_coherent (uq :: first_column pss)) then
+ if not (all_coherent (huq :: first_column pss)) then
Unused
else begin
let q0 = discr_pat q pss in
every_satisfiables
(build_specialized_submatrix q0 pss
~extend_row:(fun ps r -> { r with active = ps @ r.active }))
- {qs with active=simple_match_args q0 q @ rem}
+ {qs with active=simple_match_args q0 huq args @ rem}
end
end
in
mkpat (Ppat_construct(lid, arg))
| Tpat_variant(label,p_opt,_row_desc) ->
- let arg = Misc.may_map loop p_opt in
+ let arg = Option.map loop p_opt in
mkpat (Ppat_variant(label, arg))
| Tpat_record (subpatterns, _closed_flag) ->
let fields =
(* Whether the counter-example contains an extension pattern *)
let contains_extension pat =
- let r = ref false in
- let rec loop = function
- {pat_desc=Tpat_var (_, {txt="*extension*"})} ->
- r := true
- | p -> Typedtree.iter_pattern_desc loop p.pat_desc
- in loop pat; !r
+ exists_pattern
+ (function
+ | {pat_desc=Tpat_var (_, {txt="*extension*"})} -> true
+ | _ -> false)
+ pat
(* Build an untyped or-pattern from its expected type *)
let ppat_of_type env ty =
let rest_of_the_row =
{ row = ps; varsets = Ident.Set.add x head_bound_variables :: varsets; }
in
- add_column omega rest_of_the_row k
+ add_column (Pattern_head.deconstruct omega) rest_of_the_row k
| Tpat_or (p1,p2,_) ->
simpl head_bound_variables varsets p1 ps
(simpl head_bound_variables varsets p2 ps k)
| _ ->
- add_column p { row = ps; varsets = head_bound_variables :: varsets; } k
+ add_column (Pattern_head.deconstruct p)
+ { row = ps; varsets = head_bound_variables :: varsets; } k
in simpl head_bound_variables varsets p ps k
(*
Tmod_unpack ({exp_desc=Texp_ident (Path.Pident id_exp,_,_)},_)},
_) ->
assert (Ident.Set.mem id_exp !ids) ;
- if not (Ident.Set.mem id_mod !ids) then begin
+ begin match id_mod with
+ | Some id_mod when not (Ident.Set.mem id_mod !ids) ->
ids := Ident.Set.remove id_exp !ids
+ | _ -> ()
end
| _ -> assert false
end
(** Exported compatibility functor, abstracted over constructor equality *)
module Compat :
functor
- (Constr: sig
+ (_ : sig
val equal :
Types.constructor_description ->
Types.constructor_description ->
(string, label_description) Hashtbl.t
val pressure_variants: Env.t -> pattern list -> unit
+
+(** [check_partial pred loc caselist] and [check_unused refute pred caselist]
+ are called with a function [pred] which will be given counter-example
+ candidates: they may be partially ill-typed, and have to be type-checked
+ to extract a valid counter-example.
+ [pred] returns a valid counter-example or [None].
+ [refute] indicates that [check_unused] was called on a refutation clause.
+ *)
val check_partial:
((string, constructor_description) Hashtbl.t ->
(string, label_description) Hashtbl.t ->
val last: t -> string
+val is_uident: string -> bool
+
type typath =
| Regular of t
| Ext of t * string
let open Format in
function
| Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
- "Wrong file naming: %a@ contains the compiled interface for @ \
+ "Wrong file naming: %a@ contains the compiled interface for@ \
%s when %s was expected"
Location.print_filename filename ps_name modname
| Inconsistent_import(name, source1, source2) -> fprintf ppf
[penv] (it may have failed) *)
val looked_up : 'a t -> modname -> bool
-(* [is_imported penv md] checks if [md] has been succesfully
+(* [is_imported penv md] checks if [md] has been successfully
imported in the environment [penv] *)
val is_imported : 'a t -> modname -> bool
type_is_newtype = false;
type_expansion_scope = lowest_level;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
-let decl_abstr_imm = {decl_abstr with type_immediate = true}
+let decl_abstr_imm = {decl_abstr with type_immediate = Always}
let cstr id args =
{
let decl_bool =
{decl_abstr with
type_kind = Type_variant([cstr ident_false []; cstr ident_true []]);
- type_immediate = true}
+ type_immediate = Always}
and decl_unit =
{decl_abstr with
type_kind = Type_variant([cstr ident_void []]);
- type_immediate = true}
+ type_immediate = Always}
and decl_exn =
{decl_abstr with
type_kind = Type_open}
val path_assert_failure : Path.t
val path_undefined_recursive_module : Path.t
+val ident_false : Ident.t
+val ident_true : Ident.t
+val ident_void : Ident.t
+val ident_nil : Ident.t
+val ident_cons : Ident.t
+val ident_none : Ident.t
+val ident_some : Ident.t
+
(* To build the initial environment. Since there is a nasty mutual
recursion between predef and env, we break it by parameterizing
over Env.t, Env.add_type and Env.add_extension. *)
let byte_name p =
p.prim_name
+let native_name_is_external p =
+ let nat_name = native_name p in
+ nat_name <> "" && nat_name.[0] <> '%'
+
let report_error ppf err =
match err with
| Old_style_float_with_native_repr_attribute ->
val native_name: description -> string
val byte_name: description -> string
+(** [native_name_is_externa] returns [true] iff the [native_name] for the
+ given primitive identifies that the primitive is not implemented in the
+ compiler itself. *)
+val native_name_is_external : description -> bool
+
type error =
| Old_style_float_with_native_repr_attribute
| Old_style_noalloc_with_noalloc_attribute
| Ldot(p, s) -> fprintf ppf "%a.%s" longident p s
| Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
+let () = Env.print_longident := longident
+
(* Print an identifier avoiding name collisions *)
module Out_name = struct
| Class_type -> "class type"
| Other -> ""
+ let pp ppf x = Format.pp_print_string ppf (show x)
+
let lookup =
let to_lookup f lid =
- fst @@ f ?loc:None ?mark:(Some false) (Lident lid) !printing_env in
+ fst @@ f (Lident lid) !printing_env
+ in
function
- | Type -> fun id ->
- Env.lookup_type ?loc:None ~mark:false (Lident id) !printing_env
- | Module -> fun id ->
- Env.lookup_module ~load:true ~mark:false ?loc:None
- (Lident id) !printing_env
- | Module_type -> to_lookup Env.lookup_modtype
- | Class -> to_lookup Env.lookup_class
- | Class_type -> to_lookup Env.lookup_cltype
+ | Type -> to_lookup Env.find_type_by_name
+ | Module -> to_lookup Env.find_module_by_name
+ | Module_type -> to_lookup Env.find_modtype_by_name
+ | Class -> to_lookup Env.find_class_by_name
+ | Class_type -> to_lookup Env.find_cltype_by_name
| Other -> fun _ -> raise Not_found
let location namespace id =
*)
module Conflicts = struct
module M = String.Map
- type explanation = { kind: namespace; name:string; location:Location.t}
+ type explanation =
+ { kind: namespace; name:string; root_name:string; location:Location.t}
let explanations = ref M.empty
- let explain namespace n id =
+ let collect_explanation namespace n id =
let name = human_unique n id in
+ let root_name = Ident.name id in
if not (M.mem name !explanations) then
match Namespace.location namespace id with
| None -> ()
| Some location ->
- explanations :=
- M.add name { kind = namespace; location; name } !explanations
+ let explanation = { kind = namespace; location; name; root_name } in
+ explanations := M.add name explanation !explanations
let pp_explanation ppf r=
Format.fprintf ppf "@[<v 2>%a:@,Definition of %s %s@]"
Location.print_loc r.location (Namespace.show r.kind) r.name
- let pp ppf l =
+ let print_located_explanations ppf l =
Format.fprintf ppf "@[<v>%a@]" (Format.pp_print_list pp_explanation) l
let reset () = explanations := M.empty
- let take () =
+ let list_explanations () =
let c = !explanations in
reset ();
c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
- let print ppf =
- let sep ppf = Format.fprintf ppf "@ " in
- let l =
- List.filter (* remove toplevel locations, since they are too imprecise *)
- ( fun a ->
- a.location.Location.loc_start.Lexing.pos_fname <> "//toplevel//" )
- (take ()) in
- match l with
+
+ let print_toplevel_hint ppf l =
+ let conj ppf () = Format.fprintf ppf " and@ " in
+ let pp_namespace_plural ppf n = Format.fprintf ppf "%as" Namespace.pp n in
+ let root_names = List.map (fun r -> r.kind, r.root_name) l in
+ let unique_root_names = List.sort_uniq Stdlib.compare root_names in
+ let submsgs = Array.make Namespace.size [] in
+ let () = List.iter (fun (n,_ as x) ->
+ submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
+ ) unique_root_names in
+ let pp_submsg ppf names =
+ match names with
+ | [] -> ()
+ | [namespace, a] ->
+ Format.fprintf ppf
+ "@ \
+ @[<2>Hint: The %a %s has been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
+ @ Did you try to redefine them?@]"
+ Namespace.pp namespace a Namespace.pp namespace
+ | (namespace, _) :: _ :: _ ->
+ Format.fprintf ppf
+ "@ \
+ @[<2>Hint: The %a %a have been defined multiple times@ \
+ in@ this@ toplevel@ session.@ \
+ Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
+ @ Did you try to redefine them?@]"
+ pp_namespace_plural namespace
+ Format.(pp_print_list ~pp_sep:conj pp_print_string) (List.map snd names)
+ pp_namespace_plural namespace in
+ Array.iter (pp_submsg ppf) submsgs
+
+ let print_explanations ppf =
+ let ltop, l =
+ (* isolate toplevel locations, since they are too imprecise *)
+ let from_toplevel a =
+ a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
+ List.partition from_toplevel (list_explanations ())
+ in
+ begin match l with
| [] -> ()
- | l -> Format.fprintf ppf "%t%a" sep pp l
+ | l -> Format.fprintf ppf "@ %a" print_located_explanations l
+ end;
+ (* if there are name collisions in a toplevel session,
+ display at least one generic hint by namespace *)
+ print_toplevel_hint ppf ltop
let exists () = M.cardinal !explanations >0
end
| Uniquely_associated_to (id',r) ->
let hid, map = add_hid_id id' Ident.Map.empty in
Out_name.set r (human_unique hid id');
- Conflicts.explain namespace hid id';
+ Conflicts.collect_explanation namespace hid id';
set namespace @@ M.add name (Need_unique_name map) (get namespace);
Out_name.create (pervasives name)
| exception Not_found ->
r
| Need_unique_name map ->
let hid, m = find_hid id map in
- Conflicts.explain namespace hid id;
+ Conflicts.collect_explanation namespace hid id;
set namespace @@ M.add name (Need_unique_name m) (get namespace);
Out_name.create (human_unique hid id)
| Uniquely_associated_to (id',r) ->
let hid', m = find_hid id' Ident.Map.empty in
let hid, m = find_hid id m in
Out_name.set r (human_unique hid' id');
- List.iter (fun (id,hid) -> Conflicts.explain namespace hid id)
+ List.iter (fun (id,hid) -> Conflicts.collect_explanation namespace hid id)
[id, hid; id', hid' ];
set namespace @@ M.add name (Need_unique_name m) (get namespace);
Out_name.create (human_unique hid id)
let non_shadowed_pervasive = function
| Pdot(Pident id, s) as path ->
Ident.same id ident_stdlib &&
- (try Path.same path (Env.lookup_type (Lident s) !printing_env)
- with Not_found -> true)
+ (match Env.find_type_by_name (Lident s) !printing_env with
+ | (path', _) -> Path.same path path'
+ | exception Not_found -> true)
| _ -> false
let find_double_underscore s =
String.capitalize_ascii
(String.sub name (i + 2) (String.length name - i - 2)))
in
- match Env.lookup_module ~load:true better_lid env with
+ match Env.find_module_by_name better_lid env with
| exception Not_found -> p
- | p' ->
- if module_path_is_an_alias_of env p' ~alias_of:p then
- p'
- else
+ | p', _ ->
+ if module_path_is_an_alias_of env p' ~alias_of:p then
+ p'
+ else
p
let rewrite_double_underscore_paths env p =
Oide_ident (ident_name namespace id)
| Pdot(_, s) as path when non_shadowed_pervasive path ->
Oide_ident (Naming_context.pervasives_name namespace s)
+ | Pdot(Pident t, s)
+ when namespace=Type && not (Path.is_uident (Ident.name t)) ->
+ (* [t.A]: inline record of the constructor [A] from type [t] *)
+ Oide_dot (Oide_ident (ident_name Type t), s)
| Pdot(p, s) ->
Oide_dot (tree_of_path Module p, s)
| Papply(p1, p2) ->
let trees = List.map (tree_of_path namespace) p in
List.map (Format.asprintf "%a" !Oprint.out_ident) trees
+let () = Env.print_path := path
+
(* Print a recursive annotation *)
let tree_of_rec = function
raw_type_list tl
| Tvariant row ->
fprintf ppf
- "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%B;@ @[<1>%s%t@]}@]"
+ "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
"row_fields="
(raw_list (fun ppf (l, f) ->
fprintf ppf "@[%s,@ %a@]" l raw_field f))
row.row_fields
"row_more=" raw_type row.row_more
"row_closed=" row.row_closed
- "row_fixed=" row.row_fixed
+ "row_fixed=" raw_row_fixed row.row_fixed
"row_name="
(fun ppf ->
match row.row_name with None -> fprintf ppf "None"
| Tpackage (p, _, tl) ->
fprintf ppf "@[<hov1>Tpackage(@,%a@,%a)@]" path p
raw_type_list tl
+and raw_row_fixed ppf = function
+| None -> fprintf ppf "None"
+| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
+| Some Types.Rigid -> fprintf ppf "Some Rigid"
+| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t
+| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p
and raw_field ppf = function
Rpresent None -> fprintf ppf "Rpresent None"
if error then Env.without_cmis (wrap_printing_env env) f
else wrap_printing_env env f
+let rec lid_of_path = function
+ Path.Pident id ->
+ Longident.Lident (Ident.name id)
+ | Path.Pdot (p1, s) ->
+ Longident.Ldot (lid_of_path p1, s)
+ | Path.Papply (p1, p2) ->
+ Longident.Lapply (lid_of_path p1, lid_of_path p2)
+
let is_unambiguous path env =
let l = Env.find_shadowed_types path env in
List.exists (Path.same path) l || (* concrete paths are ok *)
(* also allow repeatedly defining and opening (for toplevel) *)
let id = lid_of_path p in
List.for_all (fun p -> lid_of_path p = id) rem &&
- Path.same p (Env.lookup_type id env)
+ Path.same p (fst (Env.find_type_by_name id env))
let rec get_best_path r =
match !r with
let typexp sch ppf ty =
!Oprint.out_type ppf (tree_of_typexp sch ty)
-let type_expr ppf ty = typexp false ppf ty
+let marked_type_expr ppf ty = typexp false ppf ty
+
+let type_expr ppf ty =
+ (* [type_expr] is used directly by error message printers,
+ we mark eventual loops ourself to avoid any misuse and stack overflow *)
+ reset_and_mark_loops ty;
+ marked_type_expr ppf ty
and type_sch ppf ty = typexp true ppf ty
List.iter
(fun c ->
mark_loops_constructor_arguments c.cd_args;
- may mark_loops c.cd_res)
+ Option.iter mark_loops c.cd_res)
cstrs
| Type_record(l, _rep) ->
List.iter (fun l -> mark_loops l.ld_type) l
| Type_open ->
tree_of_manifest Otyp_open,
decl.type_private
- in
- let immediate =
- Builtin_attributes.immediate decl.type_attributes
in
{ otype_name = name;
otype_params = args;
otype_type = ty;
otype_private = priv;
- otype_immediate = immediate;
+ otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
otype_unboxed = decl.type_unboxed.unboxed;
otype_cstrs = constraints }
and tree_of_label l =
(Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+let constructor ppf c =
+ reset_except_context ();
+ !Oprint.out_constr ppf (tree_of_constructor c)
+
+let label ppf l =
+ reset_except_context ();
+ !Oprint.out_label ppf (tree_of_label l)
+
let tree_of_type_declaration id decl rs =
Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
(* Print an extension declaration *)
+let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
+ match ext_ret_type with
+ | None -> (tree_of_constructor_arguments ext_args, None)
+ | Some res ->
+ let nm = !names in
+ names := [];
+ let ret = tree_of_typexp false res in
+ let args = tree_of_constructor_arguments ext_args in
+ names := nm;
+ (args, Some ret)
+
let tree_of_extension_constructor id ext es =
reset_except_context ();
let ty_name = Path.name ext.ext_type_path in
List.iter mark_loops ty_params;
List.iter check_name_of_type (List.map proxy ty_params);
mark_loops_constructor_arguments ext.ext_args;
- may mark_loops ext.ext_ret_type;
+ Option.iter mark_loops ext.ext_ret_type;
let type_param =
function
| Otyp_var (_, id) -> id
in
let name = Ident.name id in
let args, ret =
- match ext.ext_ret_type with
- | None -> (tree_of_constructor_arguments ext.ext_args, None)
- | Some res ->
- let nm = !names in
- names := [];
- let ret = tree_of_typexp false res in
- let args = tree_of_constructor_arguments ext.ext_args in
- names := nm;
- (args, Some ret)
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
in
let ext =
{ oext_name = name;
let extension_constructor id ppf ext =
!Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
+let extension_only_constructor id ppf ext =
+ reset_except_context ();
+ let name = Ident.name id in
+ let args, ret =
+ extension_constructor_args_and_ret_type_subtree
+ ext.ext_args
+ ext.ext_ret_type
+ in
+ Format.fprintf ppf "@[<hv>%a@]"
+ !Oprint.out_constr (name, args, ret)
+
(* Print a value declaration *)
let tree_of_value_description id decl =
type_is_newtype = false; type_expansion_scope = Btype.lowest_level;
type_loc = Location.none;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
| Mty_signature sg ->
Omty_signature (if ellipsis then [Osig_ellipsis]
else tree_of_signature sg)
- | Mty_functor(param, ty_arg, ty_res) ->
- let res =
- match ty_arg with None -> tree_of_modtype ~ellipsis ty_res
- | Some mty ->
- wrap_env (Env.add_module ~arg:true param Mp_present mty)
- (tree_of_modtype ~ellipsis) ty_res
+ | Mty_functor(param, ty_res) ->
+ let param, res =
+ match param with
+ | Unit -> None, tree_of_modtype ~ellipsis ty_res
+ | Named (param, ty_arg) ->
+ let name, env =
+ match param with
+ | None -> None, fun env -> env
+ | Some id ->
+ Some (Ident.name id),
+ Env.add_module ~arg:true id Mp_present ty_arg
+ in
+ Some (name, tree_of_modtype ~ellipsis:false ty_arg),
+ wrap_env env (tree_of_modtype ~ellipsis) ty_res
in
- Omty_functor (Ident.name param,
- may_map (tree_of_modtype ~ellipsis:false) ty_arg, res)
+ Omty_functor (param, res)
| Mty_alias p ->
Omty_alias (tree_of_path Module p)
if Warnings.(is_active @@ Erroneous_printed_signature "")
&& Conflicts.exists ()
then begin
- let conflicts = Format.asprintf "%t" Conflicts.print in
+ let conflicts = Format.asprintf "%t" Conflicts.print_explanations in
Location.prerr_warning (Location.in_file sourcefile)
(Warnings.Erroneous_printed_signature conflicts);
Warnings.check_fatal ()
mark_loops t; (t, t)
| _ -> prepare_expansion (t, t')
-let print_tags ppf fields =
- match fields with [] -> ()
- | (t, _) :: fields ->
- fprintf ppf "`%s" t;
- List.iter (fun (t, _) -> fprintf ppf ",@ `%s" t) fields
+let print_tag ppf = fprintf ppf "`%s"
+
+let print_tags =
+ let comma ppf () = Format.fprintf ppf ",@ " in
+ Format.pp_print_list ~pp_sep:comma print_tag
let is_unit env ty =
match (Ctype.expand_head env ty).desc with
| Trace.First -> fprintf ppf "first"
| Trace.Second -> fprintf ppf "second"
+let explain_fixed_row_case ppf = function
+ | Trace.Cannot_be_closed -> Format.fprintf ppf "it cannot be closed"
+ | Trace.Cannot_add_tags tags ->
+ Format.fprintf ppf "it may not allow the tag(s) %a"
+ print_tags tags
+
+let explain_fixed_row pos expl = match expl with
+ | Types.Fixed_private ->
+ dprintf "The %a variant type is private" print_pos pos
+ | Types.Univar x ->
+ dprintf "The %a variant type is bound to the universal type variable %a"
+ print_pos pos type_expr x
+ | Types.Reified p ->
+ let p = tree_of_path Type p in
+ dprintf "The %a variant type is bound to %a" print_pos pos
+ !Oprint.out_ident p
+ | Types.Rigid -> ignore
+
let explain_variant = function
| Trace.No_intersection ->
Some(dprintf "@,These two variant types have no intersection")
dprintf
"@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
print_pos pos
- print_tags fields
+ print_tags (List.map fst fields)
)
| Trace.Incompatible_types_for s ->
Some(dprintf "@,Types for tag `%s are incompatible" s)
+ | Trace.Fixed_row (pos, k, (Univar _ | Reified _ | Fixed_private as e)) ->
+ Some (
+ dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e)
+ explain_fixed_row_case k
+ )
+ | Trace.Fixed_row (_,_, Rigid) ->
+ (* this case never happens *)
+ None
+
let explain_escape intro prev ctx e =
let pre = match ctx with
| Trace.Variant v -> explain_variant v
| Trace.Obj o -> explain_object o
| Trace.Rec_occur(x,y) ->
- mark_loops y;
+ reset_and_mark_loops y;
Some(dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
- type_expr x type_expr y)
+ marked_type_expr x marked_type_expr y)
let mismatch intro env trace =
Trace.explain trace (fun ~prev h -> explanation intro prev env h)
(explain mis);
if env <> Env.empty
then warn_on_missing_defs env ppf head;
- Conflicts.print ppf;
+ Conflicts.print_explanations ppf;
print_labels := true
with exn ->
print_labels := true;
fprintf ppf "%a%t%t@]"
(trace false (mis = None) "is not compatible with type") tr2
(explain mis)
- Conflicts.print
+ Conflicts.print_explanations
)
type explanation =
{ kind: namespace;
- name:string; location:Location.t}
+ name:string;
+ root_name:string;
+ location:Location.t
+ }
+
+ val list_explanations: unit -> explanation list
+(** [list_explanations()] return the list of conflict explanations
+ collected up to this point, and reset the list of collected
+ explanations *)
+
+ val print_located_explanations:
+ Format.formatter -> explanation list -> unit
+
+ val print_explanations: Format.formatter -> unit
+ (** Print all conflict explanations collected up to this point *)
- val take: unit -> explanation list
- val pp: Format.formatter -> explanation list -> unit
- val print: Format.formatter -> unit
val reset: unit -> unit
end
val mark_loops: type_expr -> unit
val reset_and_mark_loops: type_expr -> unit
val reset_and_mark_loops_list: type_expr list -> unit
+
val type_expr: formatter -> type_expr -> unit
+val marked_type_expr: formatter -> type_expr -> unit
+(** The function [type_expr] is the safe version of the pair
+ [(typed_expr, marked_type_expr)]:
+ it takes care of marking loops in the type expression and resetting
+ type variable names before printing.
+ Contrarily, the function [marked_type_expr] should only be called on
+ type expressions whose loops have been marked or it may stackoverflow
+ (see #8860 for examples).
+ *)
+
val constructor_arguments: formatter -> constructor_arguments -> unit
val tree_of_type_scheme: type_expr -> out_type
val type_sch : formatter -> type_expr -> unit
(* End Maxence *)
val tree_of_value_description: Ident.t -> value_description -> out_sig_item
val value_description: Ident.t -> formatter -> value_description -> unit
+val label : formatter -> label_declaration -> unit
+val constructor : formatter -> constructor_declaration -> unit
val tree_of_type_declaration:
Ident.t -> type_declaration -> rec_status -> out_sig_item
val type_declaration: Ident.t -> formatter -> type_declaration -> unit
Ident.t -> extension_constructor -> ext_status -> out_sig_item
val extension_constructor:
Ident.t -> formatter -> extension_constructor -> unit
+(* Prints extension constructor with the type signature:
+ type ('a, 'b) bar += A of float
+*)
+
+val extension_only_constructor:
+ Ident.t -> formatter -> extension_constructor -> unit
+(* Prints only extension constructor without type signature:
+ A of float
+*)
+
val tree_of_module:
Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
val modtype: formatter -> module_type -> unit
let fmt_ident = Ident.print
+let fmt_modname f = function
+ | None -> fprintf f "_";
+ | Some id -> Ident.print f id
+
let rec fmt_path_aux f x =
match x with
| Path.Pident (s) -> fprintf f "%a" fmt_ident s;
line i ppf "Texp_override\n";
list i string_x_expression ppf l;
| Texp_letmodule (s, _, _, me, e) ->
- line i ppf "Texp_letmodule \"%a\"\n" fmt_ident s;
+ line i ppf "Texp_letmodule \"%a\"\n" fmt_modname s;
module_expr i ppf me;
expression i ppf e;
| Texp_letexception (cd, e) ->
| Tmty_signature (s) ->
line i ppf "Tmty_signature\n";
signature i ppf s;
- | Tmty_functor (s, _, mt1, mt2) ->
- line i ppf "Tmty_functor \"%a\"\n" fmt_ident s;
- Misc.may (module_type i ppf) mt1;
+ | Tmty_functor (Unit, mt2) ->
+ line i ppf "Tmty_functor ()\n";
+ module_type i ppf mt2;
+ | Tmty_functor (Named (s, _, mt1), mt2) ->
+ line i ppf "Tmty_functor \"%a\"\n" fmt_modname s;
+ module_type i ppf mt1;
module_type i ppf mt2;
| Tmty_with (mt, l) ->
line i ppf "Tmty_with\n";
line i ppf "Tsig_exception\n";
type_exception i ppf ext
| Tsig_module md ->
- line i ppf "Tsig_module \"%a\"\n" fmt_ident md.md_id;
+ line i ppf "Tsig_module \"%a\"\n" fmt_modname md.md_id;
attributes i ppf md.md_attributes;
module_type i ppf md.md_type
| Tsig_modsubst ms ->
attribute i ppf "Tsig_attribute" a
and module_declaration i ppf md =
- line i ppf "%a" fmt_ident md.md_id;
+ line i ppf "%a" fmt_modname md.md_id;
attributes i ppf md.md_attributes;
module_type (i+1) ppf md.md_type;
and module_binding i ppf x =
- line i ppf "%a\n" fmt_ident x.mb_id;
+ line i ppf "%a\n" fmt_modname x.mb_id;
attributes i ppf x.mb_attributes;
module_expr (i+1) ppf x.mb_expr
| Tmod_structure (s) ->
line i ppf "Tmod_structure\n";
structure i ppf s;
- | Tmod_functor (s, _, mt, me) ->
- line i ppf "Tmod_functor \"%a\"\n" fmt_ident s;
- Misc.may (module_type i ppf) mt;
+ | Tmod_functor (Unit, me) ->
+ line i ppf "Tmod_functor ()\n";
+ module_expr i ppf me;
+ | Tmod_functor (Named (s, _, mt), me) ->
+ line i ppf "Tmod_functor \"%a\"\n" fmt_modname s;
+ module_type i ppf mt;
module_expr i ppf me;
| Tmod_apply (me1, me2, _) ->
line i ppf "Tmod_apply\n";
path pth
| Tmod_structure s ->
structure s
- | Tmod_functor (_, _, _, e) ->
+ | Tmod_functor (_, e) ->
modexp e << Delay
| Tmod_apply (f, p, _) ->
join [
Env.join (modexp mexp m) (Env.remove_list included_ids env)
(* G |- module M = E : m -| G *)
-and module_binding : (Ident.t * Typedtree.module_expr) -> bind_judg =
+and module_binding : (Ident.t option * Typedtree.module_expr) -> bind_judg =
fun (id, mexp) m env ->
(*
GE |- E: m[mM + Guard]
-------------------------------------
GE + G |- module M = E : m -| M:mM, G
*)
- let mM, env = Env.take id env in
- let judg_E = modexp mexp << (Mode.join mM Guard) in
+ let judg_E, env =
+ match id with
+ | None -> modexp mexp << Guard, env
+ | Some id ->
+ let mM, env = Env.take id env in
+ let judg_E = modexp mexp << (Mode.join mM Guard) in
+ judg_E, env
+ in
Env.join (judg_E m) env
and open_declaration : Typedtree.open_declaration -> bind_judg =
Env.join (judg_E m) (Env.remove_list bound_ids env)
and recursive_module_bindings
- : (Ident.t * Typedtree.module_expr) list -> bind_judg =
+ : (Ident.t option * Typedtree.module_expr) list -> bind_judg =
fun m_bindings m env ->
- let mids = List.map fst m_bindings in
+ let mids = List.filter_map fst m_bindings in
let binding (mid, mexp) m =
- let mM = Env.find mid env in
- Env.remove_list mids (modexp mexp Mode.(compose m (join mM Guard)))
+ let judg_E =
+ match mid with
+ | None -> modexp mexp << Guard
+ | Some mid ->
+ let mM = Env.find mid env in
+ modexp mexp << (Mode.join mM Guard)
+ in
+ Env.remove_list mids (judg_E m)
in
Env.join (list binding m_bindings m) (Env.remove_list mids env)
{
cd_id = c.cd_id;
cd_args = constructor_arguments copy_scope s c.cd_args;
- cd_res = may_map (typexp copy_scope s) c.cd_res;
+ cd_res = Option.map (typexp copy_scope s) c.cd_res;
cd_loc = loc s c.cd_loc;
cd_attributes = attrs s c.cd_attributes;
}
{ ext_type_path = type_path s ext.ext_type_path;
ext_type_params = List.map (typexp copy_scope s) ext.ext_type_params;
ext_args = constructor_arguments copy_scope s ext.ext_args;
- ext_ret_type = may_map (typexp copy_scope s) ext.ext_ret_type;
+ ext_ret_type = Option.map (typexp copy_scope s) ext.ext_ret_type;
ext_private = ext.ext_private;
ext_attributes = attrs s ext.ext_attributes;
ext_loc = if s.for_saving then Location.none else ext.ext_loc; }
end
| Mty_signature sg ->
Mty_signature(signature scoping s sg)
- | Mty_functor(id, arg, res) ->
+ | Mty_functor(Unit, res) ->
+ Mty_functor(Unit, modtype scoping s res)
+ | Mty_functor(Named (None, arg), res) ->
+ Mty_functor(Named (None, (modtype scoping s) arg), modtype scoping s res)
+ | Mty_functor(Named (Some id, arg), res) ->
let id' = Ident.rename id in
- Mty_functor(id', may_map (modtype scoping s) arg,
- modtype scoping (add_module id (Pident id') s) res)
+ Mty_functor(Named (Some id', (modtype scoping s) arg),
+ modtype scoping (add_module id (Pident id') s) res)
| Mty_alias p ->
Mty_alias (module_path s p)
and modtype_declaration scoping s decl =
{
- mtd_type = may_map (modtype scoping s) decl.mtd_type;
+ mtd_type = Option.map (modtype scoping s) decl.mtd_type;
mtd_attributes = attrs s decl.mtd_attributes;
mtd_loc = loc s decl.mtd_loc;
}
let class_description sub x =
class_infos sub (sub.class_type sub) x
+let functor_parameter sub = function
+ | Unit -> ()
+ | Named (_, _, mtype) -> sub.module_type sub mtype
+
let module_type sub {mty_desc; mty_env; _} =
sub.env sub mty_env;
match mty_desc with
| Tmty_ident _ -> ()
| Tmty_alias _ -> ()
| Tmty_signature sg -> sub.signature sub sg
- | Tmty_functor (_, _, mtype1, mtype2) ->
- Option.iter (sub.module_type sub) mtype1;
+ | Tmty_functor (arg, mtype2) ->
+ functor_parameter sub arg;
sub.module_type sub mtype2
| Tmty_with (mtype, list) ->
sub.module_type sub mtype;
match mod_desc with
| Tmod_ident _ -> ()
| Tmod_structure st -> sub.structure sub st
- | Tmod_functor (_, _, mtype, mexpr) ->
- Option.iter (sub.module_type sub) mtype;
+ | Tmod_functor (arg, mexpr) ->
+ functor_parameter sub arg;
sub.module_expr sub mexpr
| Tmod_apply (mexp1, mexp2, c) ->
sub.module_expr sub mexp1;
let id x = x
let tuple2 f1 f2 (x, y) = (f1 x, f2 y)
let tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
-let opt f = function None -> None | Some x -> Some (f x)
-
let structure sub {str_items; str_type; str_final_env} =
{
}
let module_type_declaration sub x =
- let mtd_type = opt (sub.module_type sub) x.mtd_type in
+ let mtd_type = Option.map (sub.module_type sub) x.mtd_type in
{x with mtd_type}
let module_declaration sub x =
let constructor_decl sub cd =
let cd_args = constructor_args sub cd.cd_args in
- let cd_res = opt (sub.typ sub) cd.cd_res in
+ let cd_res = Option.map (sub.typ sub) cd.cd_res in
{cd with cd_args; cd_res}
let type_kind sub = function
x.typ_cstrs
in
let typ_kind = sub.type_kind sub x.typ_kind in
- let typ_manifest = opt (sub.typ sub) x.typ_manifest in
+ let typ_manifest = Option.map (sub.typ sub) x.typ_manifest in
let typ_params = List.map (tuple2 (sub.typ sub) id) x.typ_params in
{x with typ_cstrs; typ_kind; typ_manifest; typ_params}
let ext_kind =
match x.ext_kind with
Text_decl(ctl, cto) ->
- Text_decl(constructor_args sub ctl, opt (sub.typ sub) cto)
+ Text_decl(constructor_args sub ctl, Option.map (sub.typ sub) cto)
| Text_rebind _ as d -> d
in
{x with ext_kind}
| Tpat_tuple l -> Tpat_tuple (List.map (sub.pat sub) l)
| Tpat_construct (loc, cd, l) ->
Tpat_construct (loc, cd, List.map (sub.pat sub) l)
- | Tpat_variant (l, po, rd) -> Tpat_variant (l, opt (sub.pat sub) po, rd)
+ | Tpat_variant (l, po, rd) ->
+ Tpat_variant (l, Option.map (sub.pat sub) po, rd)
| Tpat_record (l, closed) ->
Tpat_record (List.map (tuple3 id id (sub.pat sub)) l, closed)
| Tpat_array l -> Tpat_array (List.map (sub.pat sub) l)
| Texp_constraint cty ->
Texp_constraint (sub.typ sub cty)
| Texp_coerce (cty1, cty2) ->
- Texp_coerce (opt (sub.typ sub) cty1, sub.typ sub cty2)
+ Texp_coerce (Option.map (sub.typ sub) cty1, sub.typ sub cty2)
| Texp_newtype _ as d -> d
- | Texp_poly cto -> Texp_poly (opt (sub.typ sub) cto)
+ | Texp_poly cto -> Texp_poly (Option.map (sub.typ sub) cto)
in
let exp_extra = List.map (tuple3 extra id id) x.exp_extra in
let exp_env = sub.env sub x.exp_env in
| Texp_apply (exp, list) ->
Texp_apply (
sub.expr sub exp,
- List.map (tuple2 id (opt (sub.expr sub))) list
+ List.map (tuple2 id (Option.map (sub.expr sub))) list
)
| Texp_match (exp, cases, p) ->
Texp_match (
| Texp_construct (lid, cd, args) ->
Texp_construct (lid, cd, List.map (sub.expr sub) args)
| Texp_variant (l, expo) ->
- Texp_variant (l, opt (sub.expr sub) expo)
+ Texp_variant (l, Option.map (sub.expr sub) expo)
| Texp_record { fields; representation; extended_expression } ->
let fields = Array.map (function
| label, Kept t -> label, Kept t
in
Texp_record {
fields; representation;
- extended_expression = opt (sub.expr sub) extended_expression;
+ extended_expression = Option.map (sub.expr sub) extended_expression;
}
| Texp_field (exp, lid, ld) ->
Texp_field (sub.expr sub exp, lid, ld)
Texp_ifthenelse (
sub.expr sub exp1,
sub.expr sub exp2,
- opt (sub.expr sub) expo
+ Option.map (sub.expr sub) expo
)
| Texp_sequence (exp1, exp2) ->
Texp_sequence (
(
sub.expr sub exp,
meth,
- opt (sub.expr sub) expo
+ Option.map (sub.expr sub) expo
)
| Texp_new _
| Texp_instvar _ as d -> d
let class_description sub x =
class_infos sub (sub.class_type sub) x
+let functor_parameter sub = function
+ | Unit -> Unit
+ | Named (id, s, mtype) -> Named (id, s, sub.module_type sub mtype)
+
let module_type sub x =
let mty_env = sub.env sub x.mty_env in
let mty_desc =
| Tmty_ident _
| Tmty_alias _ as d -> d
| Tmty_signature sg -> Tmty_signature (sub.signature sub sg)
- | Tmty_functor (id, s, mtype1, mtype2) ->
- Tmty_functor (
- id,
- s,
- opt (sub.module_type sub) mtype1,
- sub.module_type sub mtype2
- )
+ | Tmty_functor (arg, mtype2) ->
+ Tmty_functor (functor_parameter sub arg, sub.module_type sub mtype2)
| Tmty_with (mtype, list) ->
Tmty_with (
sub.module_type sub mtype,
match x.mod_desc with
| Tmod_ident _ as d -> d
| Tmod_structure st -> Tmod_structure (sub.structure sub st)
- | Tmod_functor (id, s, mtype, mexpr) ->
- Tmod_functor (
- id,
- s,
- opt (sub.module_type sub) mtype,
- sub.module_expr sub mexpr
- )
+ | Tmod_functor (arg, mexpr) ->
+ Tmod_functor (functor_parameter sub arg, sub.module_expr sub mexpr)
| Tmod_apply (mexp1, mexp2, c) ->
Tmod_apply (
sub.module_expr sub mexp1,
| Tcl_constraint (cl, clty, vals, meths, concrs) ->
Tcl_constraint (
sub.class_expr sub cl,
- opt (sub.class_type sub) clty,
+ Option.map (sub.class_type sub) clty,
vals,
meths,
concrs
| Tcl_apply (cl, args) ->
Tcl_apply (
sub.class_expr sub cl,
- List.map (tuple2 id (opt (sub.expr sub))) args
+ List.map (tuple2 id (Option.map (sub.expr sub))) args
)
| Tcl_let (rec_flag, value_bindings, ivars, cl) ->
let (rec_flag, value_bindings) =
let case sub {c_lhs; c_guard; c_rhs} =
{
c_lhs = sub.pat sub c_lhs;
- c_guard = opt (sub.expr sub) c_guard;
+ c_guard = Option.map (sub.expr sub) c_guard;
c_rhs = sub.expr sub c_rhs;
}
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2019 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type t =
+ | Unknown
+ | Always
+ | Always_on_64bits
+
+module Violation = struct
+ type t =
+ | Not_always_immediate
+ | Not_always_immediate_on_64bits
+end
+
+let coerce t ~as_ =
+ match t, as_ with
+ | _, Unknown
+ | Always, Always
+ | (Always | Always_on_64bits), Always_on_64bits -> Ok ()
+ | (Unknown | Always_on_64bits), Always ->
+ Error Violation.Not_always_immediate
+ | Unknown, Always_on_64bits ->
+ Error Violation.Not_always_immediate_on_64bits
+
+let of_attributes attrs =
+ match
+ Builtin_attributes.immediate attrs,
+ Builtin_attributes.immediate64 attrs
+ with
+ | true, _ -> Always
+ | false, true -> Always_on_64bits
+ | false, false -> Unknown
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jeremie Dimino, Jane Street Europe *)
+(* *)
+(* Copyright 2019 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Immediacy status of a type *)
+
+type t =
+ | Unknown
+ (** We don't know anything *)
+ | Always
+ (** We know for sure that values of this type are always immediate *)
+ | Always_on_64bits
+ (** We know for sure that values of this type are always immediate
+ on 64 bit platforms. For other platforms, we know nothing. *)
+
+module Violation : sig
+ type t =
+ | Not_always_immediate
+ | Not_always_immediate_on_64bits
+end
+
+(** [coerce t ~as_] returns [Ok ()] iff [t] can be seen as type
+ immediacy [as_]. For instance, [Always] can be seen as
+ [Always_on_64bits] but the opposite is not true. Return [Error _]
+ if the coercion is not possible. *)
+val coerce : t -> as_:t -> (unit, Violation.t) result
+
+(** Return the immediateness of a type as indicated by the user via
+ attributes *)
+val of_attributes : Parsetree.attributes -> t
clsty_info : Typedtree.class_type_declaration;
}
+type 'a full_class = {
+ id : Ident.t;
+ id_loc : tag loc;
+ clty: class_declaration;
+ ty_id: Ident.t;
+ cltydef: class_type_declaration;
+ obj_id: Ident.t;
+ obj_abbr: type_declaration;
+ cl_id: Ident.t;
+ cl_abbr: type_declaration;
+ arity: int;
+ pub_meths: string list;
+ coe: Warnings.loc list;
+ expr: 'a;
+ req: 'a Typedtree.class_infos;
+}
+
type error =
Unconsistent_constraint of Ctype.Unification_trace.t
| Field_type_mismatch of string * string * Ctype.Unification_trace.t
(* Enter a value in the method environment only *)
-let enter_met_env ?check loc lab kind ty val_env met_env par_env =
- let (id, val_env) =
- Env.enter_value lab
- {val_type = ty;
- val_kind = Val_unbound Val_unbound_instance_variable;
- val_attributes = [];
- Types.val_loc = loc} val_env
+let enter_met_env ?check loc lab kind unbound_kind ty val_env met_env par_env =
+ let val_env = Env.enter_unbound_value lab unbound_kind val_env in
+ let par_env = Env.enter_unbound_value lab unbound_kind par_env in
+ let (id, met_env) =
+ Env.enter_value ?check lab
+ {val_type = ty; val_kind = kind;
+ val_attributes = []; Types.val_loc = loc} met_env
in
- (id, val_env,
- Env.add_value ?check id {val_type = ty; val_kind = kind;
- val_attributes = [];
- Types.val_loc = loc} met_env,
- Env.add_value id {val_type = ty;
- val_kind = Val_unbound Val_unbound_instance_variable;
- val_attributes = [];
- Types.val_loc = loc} par_env)
+ (id, val_env, met_env, par_env)
(* Enter an instance variable in the environment *)
let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
match id with Some id -> (id, val_env, met_env, par_env)
| None ->
enter_met_env Location.none lab (Val_ivar (mut, cl_num))
- ty val_env met_env par_env
+ Val_unbound_instance_variable ty val_env met_env par_env
in
vars := Vars.add lab (id, mut, virt, ty) !vars;
result
in
match scty.pcty_desc with
Pcty_constr (lid, styl) ->
- let (path, decl) = Typetexp.find_class_type env scty.pcty_loc lid.txt in
+ let (path, decl) = Env.lookup_cltype ~loc:scty.pcty_loc lid.txt env in
if Path.same decl.clty_path unbound_class then
raise(Error(scty.pcty_loc, env, Unbound_class_type_2 lid.txt));
let (params, clty) =
| Some {txt=name} ->
let (_id, val_env, met_env, par_env) =
enter_met_env ~check:(fun s -> Warnings.Unused_ancestor s)
- sparent.pcl_loc name (Val_anc (inh_meths, cl_num)) self_type
- val_env met_env par_env
+ sparent.pcl_loc name (Val_anc (inh_meths, cl_num))
+ Val_unbound_ancestor self_type val_env met_env par_env
in
(val_env, met_env, par_env,Some name)
in
(* Check that the binder has a correct type *)
let ty =
- if final then Ctype.newty (Tobject (Ctype.newvar(), ref None))
- else self_type in
+ if final then Ctype.newobj (Ctype.newvar()) else self_type in
begin try Ctype.unify val_env public_self ty with
Ctype.Unify _ ->
raise(Error(spat.ppat_loc, val_env, Pattern_type_clash public_self))
str
)
in
- Ctype.unify val_env self_type (Ctype.newvar ());
+ Ctype.unify val_env self_type (Ctype.newvar ()); (* useless ? *)
let sign =
{csig_self = public_self;
csig_vars = Vars.map (fun (_id, mut, vr, ty) -> (mut, vr, ty)) !vars;
let priv_meths =
List.filter (fun (_,kind,_) -> Btype.field_kind_repr kind <> Fpresent)
methods in
+ (* ensure that inherited methods are listed too *)
+ List.iter (fun (met, _kind, _ty) ->
+ if Meths.mem met !meths then () else
+ ignore (Ctype.filter_self_method val_env met Private meths self_type))
+ methods;
if final then begin
(* Unify private_self and a copy of self_type. self_type will not
be modified after this point *)
and class_expr_aux cl_num val_env met_env scl =
match scl.pcl_desc with
Pcl_constr (lid, styl) ->
- let (path, decl) = Typetexp.find_class val_env scl.pcl_loc lid.txt in
+ let (path, decl) = Env.lookup_class ~loc:scl.pcl_loc lid.txt val_env in
if Path.same decl.cty_path unbound_class then
raise(Error(scl.pcl_loc, val_env, Unbound_class_2 lid.txt));
let tyl = List.map
let ty' = extract_option_type val_env ty
and ty0' = extract_option_type val_env ty0 in
let arg = type_argument val_env sarg0 ty' ty0' in
- Some (option_some arg)
+ Some (option_some val_env arg)
with Not_found ->
sargs, more_sargs,
if Btype.is_optional l
&& (List.mem_assoc Nolabel sargs
|| List.mem_assoc Nolabel more_sargs)
then
- Some (option_none ty0 Location.none)
+ Some (option_none val_env ty0 Location.none)
else None
in
let omitted = if arg = None then (l,ty0) :: omitted else omitted in
((id', expr)
:: vals,
Env.add_value id' desc met_env))
- (let_bound_idents_with_loc defs)
+ (let_bound_idents_full defs)
([], met_env)
in
let cl = class_expr cl_num val_env met_env scl' in
type_expansion_scope = Btype.lowest_level;
type_loc = loc;
type_attributes = []; (* or keep attrs from the class decl? *)
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
env
type_expansion_scope = Btype.lowest_level;
type_loc = cl.pci_loc;
type_attributes = []; (* or keep attrs from cl? *)
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
in
type_expansion_scope = Btype.lowest_level;
type_loc = cl.pci_loc;
type_attributes = []; (* or keep attrs from cl? *)
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
in
List.iter Ctype.generalize clty.cty_params;
generalize_class_type true clty.cty_type;
- Misc.may Ctype.generalize clty.cty_new;
+ Option.iter Ctype.generalize clty.cty_new;
List.iter Ctype.generalize obj_abbr.type_params;
- Misc.may Ctype.generalize obj_abbr.type_manifest;
+ Option.iter Ctype.generalize obj_abbr.type_manifest;
List.iter Ctype.generalize cl_abbr.type_params;
- Misc.may Ctype.generalize cl_abbr.type_manifest;
+ Option.iter Ctype.generalize cl_abbr.type_manifest;
if not (closed_class clty) then
raise(Error(cl.pci_loc, env, Non_generalizable_class (id, clty)));
in
raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason)))
end;
-
- (id, cl.pci_name, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
- arity, pub_meths, coe, expr,
- { ci_loc = cl.pci_loc;
- ci_virt = cl.pci_virt;
- ci_params = ci_params;
-(* TODO : check that we have the correct use of identifiers *)
- ci_id_name = cl.pci_name;
- ci_id_class = id;
- ci_id_class_type = ty_id;
- ci_id_object = obj_id;
- ci_id_typehash = cl_id;
- ci_expr = expr;
- ci_decl = clty;
- ci_type_decl = cltydef;
- ci_attributes = cl.pci_attributes;
- })
+ { id; clty; ty_id; cltydef; obj_id; obj_abbr; cl_id; cl_abbr; arity;
+ pub_meths; coe; expr;
+ id_loc = cl.pci_name;
+ req = { ci_loc = cl.pci_loc;
+ ci_virt = cl.pci_virt;
+ ci_params = ci_params;
+ (* TODO : check that we have the correct use of identifiers *)
+ ci_id_name = cl.pci_name;
+ ci_id_class = id;
+ ci_id_class_type = ty_id;
+ ci_id_object = obj_id;
+ ci_id_typehash = cl_id;
+ ci_expr = expr;
+ ci_decl = clty;
+ ci_type_decl = cltydef;
+ ci_attributes = cl.pci_attributes;
+ }
+ }
(* (cl.pci_variance, cl.pci_loc)) *)
let class_infos define_class kind
(res, env)
)
-let extract_type_decls
- (_id, _id_loc, clty, _ty_id, cltydef, obj_id, obj_abbr, _cl_id, cl_abbr,
- _arity, _pub_meths, _coe, _expr, required) decls =
- (obj_id, obj_abbr, cl_abbr, clty, cltydef, required) :: decls
+let extract_type_decls { clty; cltydef; obj_id; obj_abbr; cl_abbr; req} decls =
+ (obj_id, obj_abbr, cl_abbr, clty, cltydef, req) :: decls
-let merge_type_decls
- (id, id_loc, _clty, ty_id, _cltydef, obj_id, _obj_abbr, cl_id, _cl_abbr,
- arity, pub_meths, coe, expr, req) (obj_abbr, cl_abbr, clty, cltydef) =
- (id, id_loc, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
- arity, pub_meths, coe, expr, req)
+let merge_type_decls decl (obj_abbr, cl_abbr, clty, cltydef) =
+ {decl with obj_abbr; cl_abbr; clty; cltydef}
-let final_env define_class env
- (id, _id_loc, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
- _arity, _pub_meths, _coe, _expr, _req) =
+let final_env define_class env { id; clty; ty_id; cltydef; obj_id; obj_abbr;
+ cl_id; cl_abbr } =
(* Add definitions after cleaning them *)
Env.add_type ~check:true obj_id
(Subst.type_declaration Subst.identity obj_abbr) (
else env)))
(* Check that #c is coercible to c if there is a self-coercion *)
-let check_coercions env
- (id, id_loc, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
- arity, pub_meths, coercion_locs, _expr, req) =
- begin match coercion_locs with [] -> ()
+let check_coercions env { id; id_loc; clty; ty_id; cltydef; obj_id; obj_abbr;
+ cl_id; cl_abbr; arity; pub_meths; coe; req } =
+ begin match coe with [] -> ()
| loc :: _ ->
let cl_ty, obj_ty =
match cl_abbr.type_manifest, obj_abbr.type_manifest with
| Pattern_type_clash ty ->
(* XXX Trace *)
(* XXX Revoir message d'erreur | Improve error message *)
- Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[%s@ %a@]"
"This pattern cannot match self: it only matches values of type"
Printtyp.type_expr ty
| Private_label of Longident.t * type_expr
| Private_constructor of constructor_description * type_expr
| Unbound_instance_variable of string * string list
- | Instance_variable_not_mutable of bool * string
+ | Instance_variable_not_mutable of string
| Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t
| Outside_class
| Value_multiply_overridden of string
| Too_many_arguments of bool * type_expr * type_forcing_context option
| Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
| Scoping_let_module of string * type_expr
- | Masked_instance_variable of Longident.t
| Not_a_variant_type of Longident.t
| Incoherent_label_order
| Less_general of string * Ctype.Unification_trace.t
let case lhs rhs =
{c_lhs = lhs; c_guard = None; c_rhs = rhs}
-(* Upper approximation of free identifiers on the parse tree *)
-
-let iter_expression f e =
-
- let rec expr e =
- f e;
- match e.pexp_desc with
- | Pexp_extension _ (* we don't iterate under extension point *)
- | Pexp_ident _
- | Pexp_new _
- | Pexp_constant _ -> ()
- | Pexp_function pel -> List.iter case pel
- | Pexp_fun (_, eo, _, e) -> may expr eo; expr e
- | Pexp_apply (e, lel) -> expr e; List.iter (fun (_, e) -> expr e) lel
- | Pexp_let (_, pel, e) -> expr e; List.iter binding pel
- | Pexp_match (e, pel)
- | Pexp_try (e, pel) -> expr e; List.iter case pel
- | Pexp_array el
- | Pexp_tuple el -> List.iter expr el
- | Pexp_construct (_, eo)
- | Pexp_variant (_, eo) -> may expr eo
- | Pexp_record (iel, eo) ->
- may expr eo; List.iter (fun (_, e) -> expr e) iel
- | Pexp_open (_, e)
- | Pexp_newtype (_, e)
- | Pexp_poly (e, _)
- | Pexp_lazy e
- | Pexp_assert e
- | Pexp_setinstvar (_, e)
- | Pexp_send (e, _)
- | Pexp_constraint (e, _)
- | Pexp_coerce (e, _, _)
- | Pexp_letexception (_, e)
- | Pexp_field (e, _) -> expr e
- | Pexp_while (e1, e2)
- | Pexp_sequence (e1, e2)
- | Pexp_setfield (e1, _, e2) -> expr e1; expr e2
- | Pexp_ifthenelse (e1, e2, eo) -> expr e1; expr e2; may expr eo
- | Pexp_for (_, e1, e2, _, e3) -> expr e1; expr e2; expr e3
- | Pexp_override sel -> List.iter (fun (_, e) -> expr e) sel
- | Pexp_letmodule (_, me, e) -> expr e; module_expr me
- | Pexp_object { pcstr_fields = fs } -> List.iter class_field fs
- | Pexp_letop { let_; ands; body; _ } ->
- binding_op let_; List.iter binding_op ands; expr body
- | Pexp_pack me -> module_expr me
- | Pexp_unreachable -> ()
-
- and case {pc_lhs = _; pc_guard; pc_rhs} =
- may expr pc_guard;
- expr pc_rhs
-
- and binding_op { pbop_exp; _ } =
- expr pbop_exp
-
- and binding x =
- expr x.pvb_expr
-
- and module_expr me =
- match me.pmod_desc with
- | Pmod_extension _
- | Pmod_ident _ -> ()
- | Pmod_structure str -> List.iter structure_item str
- | Pmod_constraint (me, _)
- | Pmod_functor (_, _, me) -> module_expr me
- | Pmod_apply (me1, me2) -> module_expr me1; module_expr me2
- | Pmod_unpack e -> expr e
-
-
- and structure_item str =
- match str.pstr_desc with
- | Pstr_eval (e, _) -> expr e
- | Pstr_value (_, pel) -> List.iter binding pel
- | Pstr_primitive _
- | Pstr_type _
- | Pstr_typext _
- | Pstr_exception _
- | Pstr_modtype _
- | Pstr_open _
- | Pstr_class_type _
- | Pstr_attribute _
- | Pstr_extension _ -> ()
- | Pstr_include {pincl_mod = me}
- | Pstr_module {pmb_expr = me} -> module_expr me
- | Pstr_recmodule l -> List.iter (fun x -> module_expr x.pmb_expr) l
- | Pstr_class cdl -> List.iter (fun c -> class_expr c.pci_expr) cdl
-
- and class_expr ce =
- match ce.pcl_desc with
- | Pcl_constr _ -> ()
- | Pcl_structure { pcstr_fields = fs } -> List.iter class_field fs
- | Pcl_fun (_, eo, _, ce) -> may expr eo; class_expr ce
- | Pcl_apply (ce, lel) ->
- class_expr ce; List.iter (fun (_, e) -> expr e) lel
- | Pcl_let (_, pel, ce) ->
- List.iter binding pel; class_expr ce
- | Pcl_open (_, ce)
- | Pcl_constraint (ce, _) -> class_expr ce
- | Pcl_extension _ -> ()
-
- and class_field cf =
- match cf.pcf_desc with
- | Pcf_inherit (_, ce, _) -> class_expr ce
- | Pcf_val (_, _, Cfk_virtual _)
- | Pcf_method (_, _, Cfk_virtual _ ) | Pcf_constraint _ -> ()
- | Pcf_val (_, _, Cfk_concrete (_, e))
- | Pcf_method (_, _, Cfk_concrete (_, e)) -> expr e
- | Pcf_initializer e -> expr e
- | Pcf_attribute _ | Pcf_extension _ -> ()
-
- in
- expr e
-
-
(* Typing of constants *)
let type_constant = function
let mkexp exp_desc exp_type exp_loc exp_env =
{ exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
-let option_none ty loc =
- let lid = Longident.Lident "None"
- and env = Env.initial_safe_string in
- let cnone = Env.lookup_constructor lid env in
+let option_none env ty loc =
+ let lid = Longident.Lident "None" in
+ let cnone = Env.find_ident_constructor Predef.ident_none env in
mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc env
-let option_some texp =
+let option_some env texp =
let lid = Longident.Lident "Some" in
- let csome = Env.lookup_constructor lid Env.initial_safe_string in
+ let csome = Env.find_ident_constructor Predef.ident_some env in
mkexp ( Texp_construct(mknoloc lid , csome, [texp]) )
(type_option texp.exp_type) texp.exp_loc texp.exp_env
(* Typing of patterns *)
-(* unification inside type_pat*)
-let unify_pat_types loc env ty ty' =
- try
- unify env ty ty'
- with
- Unify trace ->
- raise(Error(loc, env, Pattern_type_clash(trace, None)))
- | Tags(l1,l2) ->
- raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2)))
-
(* unification inside type_exp and type_expect *)
let unify_exp_types loc env ty expected_ty =
(* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type
Some y -> y
| None -> assert false
-let unify_pat_types_gadt loc env ty ty' =
- try unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty'
+(* unification inside type_pat*)
+let unify_pat_types ?(refine=false) loc env ty ty' =
+ try
+ if refine then
+ unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty'
+ else
+ unify !env ty ty'
with
| Unify trace ->
raise(Error(loc, !env, Pattern_type_clash(trace, None)))
| Tags(l1,l2) ->
raise(Typetexp.Error(loc, !env, Typetexp.Variant_tags (l1, l2)))
-(* Creating new conjunctive types is not allowed when typing patterns *)
-
-let unify_pat env pat expected_ty =
- try unify_pat_types pat.pat_loc env pat.pat_type expected_ty
+let unify_pat ?refine env pat expected_ty =
+ try unify_pat_types ?refine pat.pat_loc env pat.pat_type expected_ty
with Error (loc, env, Pattern_type_clash(trace, None)) ->
raise(Error(loc, env, Pattern_type_clash(trace, Some pat.pat_desc)))
+(* Creating new conjunctive types is not allowed when typing patterns *)
(* make all Reither present in open variants *)
let finalize_variant pat =
match pat.pat_desc with
| Reither (false, ty::tl, _, e) when not row.row_closed ->
set_row_field e (Rpresent (Some ty));
begin match opat with None -> assert false
- | Some pat -> List.iter (unify_pat pat.pat_env pat) (ty::tl)
+ | Some pat ->
+ let env = ref pat.pat_env in
+ List.iter (unify_pat env pat) (ty::tl)
end
| Reither (c, _l, true, e) when not (row_fixed row) ->
set_row_field e (Reither (c, [], false, ref None))
row_bound=(); row_fixed=false; row_name=None})); *)
| _ -> ()
-let rec iter_pattern f p =
- f p;
- iter_pattern_desc (iter_pattern f) p.pat_desc
-
let has_variants p =
- try
- iter_pattern (function {pat_desc=Tpat_variant _} -> raise Exit | _ -> ())
- p;
- false
- with Exit ->
- true
-
+ exists_pattern
+ (function {pat_desc=Tpat_variant _} -> true | _ -> false)
+ p
(* pattern environment *)
type pattern_variable =
let maybe_add_pattern_variables_ghost loc_let env pv =
List.fold_right
- (fun {pv_id; pv_type; _} env ->
- let lid = Longident.Lident (Ident.name pv_id) in
- match Env.lookup_value ~mark:false lid env with
- | _ -> env
- | exception Not_found ->
- Env.add_value pv_id
- { val_type = pv_type;
- val_kind = Val_unbound Val_unbound_ghost_recursive;
- val_loc = loc_let;
- val_attributes = [];
- } env
+ (fun {pv_id; _} env ->
+ let name = Ident.name pv_id in
+ if Env.bound_value name env then env
+ else begin
+ Env.enter_unbound_value name
+ (Val_unbound_ghost_recursive loc_let) env
+ end
) pv env
let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty
if not !allow_modules then
raise (Error (loc, Env.empty, Modules_not_allowed));
module_variables := (name, loc) :: !module_variables
- end else
+ end else begin
(* moved to genannot *)
- may (fun s -> Stypes.record (Stypes.An_ident (name.loc, name.txt, s)))
- !pattern_scope;
+ Option.iter
+ (fun s -> Stypes.record (Stypes.An_ident (name.loc, name.txt, s)))
+ !pattern_scope
+ end;
id
let sort_pattern_variables vs =
(List.combine pl tyl) ty_args;
ty_res
| Tpat_variant(l, p', _) ->
- let ty = may_map (build_as_type env) p' in
+ let ty = Option.map (build_as_type env) p' in
newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
row_bound=(); row_name=None;
- row_fixed=false; row_closed=false})
+ row_fixed=None; row_closed=false})
| Tpat_record (lpl,_) ->
let lbl = snd3 (List.hd lpl) in
if lbl.lbl_private = Private then p.pat_type else
unify_pat env {arg with pat_type = build_as_type env arg} ty_arg
end else begin
let _, ty_arg', ty_res' = instance_label false lbl in
- unify env ty_arg ty_arg';
+ unify !env ty_arg ty_arg';
unify_pat env p ty_res'
end in
Array.iter do_label lbl.lbl_all;
| Tpat_array _ | Tpat_lazy _ | Tpat_exception _ -> p.pat_type
let build_or_pat env loc lid =
- let path, decl = Typetexp.find_type env lid.loc lid.txt
- in
+ let path, decl = Env.lookup_type ~loc:lid.loc lid.txt env in
let tyl = List.map (fun _ -> newvar()) decl.type_params in
let row0 =
let ty = expand_head env (newty(Tconstr(path, tyl, ref Mnil))) in
([],[]) (row_repr row0).row_fields in
let row =
{ row_fields = List.rev fields; row_more = newvar(); row_bound = ();
- row_closed = false; row_fixed = false; row_name = Some (path, tyl) }
+ row_closed = false; row_fixed = None; row_name = Some (path, tyl) }
in
let ty = newty (Tvariant row) in
let gloc = {loc with Location.loc_ghost=true} in
module NameChoice(Name : sig
type t
+ type usage
val type_kind: string
val get_name: t -> string
val get_type: t -> type_expr
- val get_descrs: Env.type_descriptions -> t list
- val unbound_name_error: Env.t -> Longident.t loc -> 'a
+ val lookup_all_from_type:
+ Location.t -> usage -> Path.t -> Env.t -> (t * (unit -> unit)) list
val in_env: t -> bool
end) = struct
open Name
| Tconstr(p, _, _) -> p
| _ -> assert false
- let lookup_from_type env tpath lid =
- let descrs = get_descrs (Env.find_type_descrs tpath env) in
- Env.mark_type_used (Path.last tpath) (Env.find_type tpath env);
+ let lookup_from_type env tpath usage lid =
+ let descrs = lookup_all_from_type lid.loc usage tpath env in
match lid.txt with
- Longident.Lident s -> begin
- try
- List.find (fun nd -> get_name nd = s) descrs
- with Not_found ->
- let names = List.map get_name descrs in
- raise (Error (lid.loc, env,
- Wrong_name ("", mk_expected (newvar ()),
- type_kind, tpath, s, names)))
+ | Longident.Lident s -> begin
+ match
+ List.find (fun (nd, _) -> get_name nd = s) descrs
+ with
+ | descr, use ->
+ use ();
+ descr
+ | exception Not_found ->
+ let names = List.map (fun (nd, _) -> get_name nd) descrs in
+ raise (Error (lid.loc, env,
+ Wrong_name ("", mk_expected (newvar ()),
+ type_kind, tpath, s, names)))
end
| _ -> raise Not_found
reset(); strings_of_paths Type tpaths)
let disambiguate_by_type env tpath lbls =
- let check_type (lbl, _) =
- let lbl_tpath = get_type_path lbl in
- compare_type_path env tpath lbl_tpath
- in
- List.find check_type lbls
+ match lbls with
+ | (Error _ : _ result) -> raise Not_found
+ | Ok lbls ->
+ let check_type (lbl, _) =
+ let lbl_tpath = get_type_path lbl in
+ compare_type_path env tpath lbl_tpath
+ in
+ List.find check_type lbls
- let disambiguate ?(warn=Location.prerr_warning) ?scope lid env opath lbls =
+ let disambiguate ?(warn=Location.prerr_warning) ?scope
+ usage lid env opath lbls =
let scope = match scope with None -> lbls | Some l -> l in
let lbl = match opath with
None ->
begin match lbls with
- [] -> unbound_name_error env lid
- | (lbl, use) :: rest ->
+ | (Error(loc', env', err) : _ result) ->
+ Env.lookup_error loc' env' err
+ | Ok [] -> assert false
+ | Ok((lbl, use) :: rest) ->
use ();
Printtyp.Conflicts.reset ();
let paths = ambiguous_types env lbl rest in
- let expansion = Format.asprintf "%t" Printtyp.Conflicts.print in
+ let expansion =
+ Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
if paths <> [] then
warn lid.loc
(Warnings.Ambiguous_name ([Longident.last lid.txt],
if not pr then begin
(* Check if non-principal type is affecting result *)
match lbls with
- [] -> warn_pr ()
- | (lbl', _use') :: rest ->
+ | (Error _ : _ result) | Ok [] -> warn_pr ()
+ | Ok ((lbl', _use') :: rest) ->
let lbl_tpath = get_type_path lbl' in
if not (compare_type_path env tpath lbl_tpath) then warn_pr ()
else
Printtyp.Conflicts.reset ();
let paths = ambiguous_types env lbl rest in
let expansion =
- Format.asprintf "%t" Printtyp.Conflicts.print in
+ Format.asprintf "%t"
+ Printtyp.Conflicts.print_explanations in
if paths <> [] then
warn lid.loc
(Warnings.Ambiguous_name ([Longident.last lid.txt],
end;
lbl
with Not_found -> try
- let lbl = lookup_from_type env tpath lid in
+ let lbl = lookup_from_type env tpath usage lid in
if in_env lbl then
begin
let s =
if not pr then warn_pr ();
lbl
with Not_found ->
- if lbls = [] then unbound_name_error env lid else
- let tp = (tpath0, expand_path env tpath) in
- let tpl =
- List.map
- (fun (lbl, _) ->
- let tp0 = get_type_path lbl in
- let tp = expand_path env tp0 in
- (tp0, tp))
- lbls
- in
- raise (Error (lid.loc, env,
- Name_type_mismatch (type_kind, lid.txt, tp, tpl)))
+ match lbls with
+ | (Error(loc', env', err) : _ result) ->
+ Env.lookup_error loc' env' err
+ | Ok lbls ->
+ let tp = (tpath0, expand_path env tpath) in
+ let tpl =
+ List.map
+ (fun (lbl, _) ->
+ let tp0 = get_type_path lbl in
+ let tp = expand_path env tp0 in
+ (tp0, tp))
+ lbls
+ in
+ raise (Error (lid.loc, env,
+ Name_type_mismatch (type_kind, lid.txt, tp, tpl)))
in
if in_env lbl then
begin match scope with
- (lab1,_)::_ when lab1 == lbl -> ()
+ | Ok ((lab1,_)::_) when lab1 == lbl -> ()
| _ ->
Location.prerr_warning lid.loc
(Warnings.Disambiguated_name(get_name lbl))
module Label = NameChoice (struct
type t = label_description
+ type usage = unit
let type_kind = "record"
let get_name lbl = lbl.lbl_name
let get_type lbl = lbl.lbl_res
- let get_descrs = snd
- let unbound_name_error = Typetexp.unbound_label_error
+ let lookup_all_from_type loc () path env =
+ Env.lookup_all_labels_from_type ~loc path env
let in_env lbl =
match lbl.lbl_repres with
| Record_regular | Record_float | Record_unboxed false -> true
there is still at least one candidate (for error message)
* if the reduced list is valid, call Label.disambiguate
*)
- let scope = Typetexp.find_all_labels env lid.loc lid.txt in
- if opath = None && scope = [] then
- Typetexp.unbound_label_error env lid;
- let (ok, labels) =
- match opath with
- Some (_, _, true) -> (true, scope) (* disambiguate only checks scope *)
- | _ -> disambiguate_label_by_ids (opath=None) closed ids scope
- in
- if ok then Label.disambiguate lid env opath labels ~warn ~scope
- else fst (List.hd labels) (* will fail later *)
+ let scope = Env.lookup_all_labels ~loc:lid.loc lid.txt env in
+ match opath, scope with
+ | None, Error(loc, env, err) ->
+ Env.lookup_error loc env err
+ | Some _, Error _ ->
+ Label.disambiguate () lid env opath scope ~warn ~scope
+ | _, Ok lbls ->
+ let (ok, lbls) =
+ match opath with
+ | Some (_, _, true) ->
+ (true, lbls) (* disambiguate only checks scope *)
+ | _ -> disambiguate_label_by_ids (opath=None) closed ids lbls
+ in
+ if ok then Label.disambiguate () lid env opath (Ok lbls) ~warn ~scope
+ else fst (List.hd lbls) (* will fail later *)
in
let lbl_a_list =
List.map (fun (lid,a) -> lid, process_label lid, a) lid_a_list in
module Constructor = NameChoice (struct
type t = constructor_description
+ type usage = Env.constructor_usage
let type_kind = "variant"
let get_name cstr = cstr.cstr_name
let get_type cstr = cstr.cstr_res
- let get_descrs = fst
- let unbound_name_error = Typetexp.unbound_constructor_error
+ let lookup_all_from_type loc usage path env =
+ Env.lookup_all_constructors_from_type ~loc usage path env
let in_env _ = true
end)
(* unification of a type with a tconstr with
freshly created arguments *)
-let unify_head_only loc env ty constr =
+let unify_head_only ~refine loc env ty constr =
let (_, ty_res) = instance_constructor constr in
- match (repr ty_res).desc with
+ let ty_res = repr ty_res in
+ match ty_res.desc with
| Tconstr(p,args,m) ->
ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m);
- enforce_constraints env ty_res;
- unify_pat_types loc env ty_res ty
+ enforce_constraints !env ty_res;
+ unify_pat_types ~refine loc env ty_res ty
| _ -> assert false
(* Typing of patterns *)
-(* Remember current state for backtracking.
- No variable information, as we only backtrack on
- patterns without variables (cf. assert statements). *)
-type state =
- { snapshot: Btype.snapshot;
- levels: Ctype.levels;
- env: Env.t; }
-let save_state env =
- { snapshot = Btype.snapshot ();
- levels = Ctype.save_levels ();
- env = !env; }
-let set_state s env =
- Btype.backtrack s.snapshot;
- Ctype.set_levels s.levels;
- env := s.env
-
-(* type_pat does not generate local constraints inside or patterns *)
-type type_pat_mode =
- | Normal
- | Splitting_or (* splitting an or-pattern *)
- | Inside_or (* inside a non-split or-pattern *)
- | Split_or (* always split or-patterns *)
-
(* "half typed" cases are produced in [type_cases] when we've just typechecked
the pattern but haven't type-checked the body yet.
At this point we might have added some type equalities to the environment,
unpacks: module_variable list;
contains_gadt: bool; }
-let all_idents_cases half_typed_cases =
- let idents = Hashtbl.create 8 in
- let f = function
- | {pexp_desc=Pexp_ident { txt = Longident.Lident id; _ }; _} ->
- Hashtbl.replace idents id ()
- | {pexp_desc=Pexp_letop{ let_; ands; _ }; _ } ->
- Hashtbl.replace idents let_.pbop_op.txt ();
- List.iter
- (fun { pbop_op; _ } -> Hashtbl.replace idents pbop_op.txt ())
- ands
- | _ -> ()
- in
- List.iter
- (fun { untyped_case = cp; _ } ->
- may (iter_expression f) cp.pc_guard;
- iter_expression f cp.pc_rhs
- )
- half_typed_cases;
- Hashtbl.fold (fun x () rest -> x :: rest) idents []
-
let rec has_literal_pattern p = match p.ppat_desc with
| Ppat_constant _
| Ppat_interval _ ->
| Ppat_or (p, q) ->
has_literal_pattern p || has_literal_pattern q
-exception Need_backtrack
-
let check_scope_escape loc env level ty =
try Ctype.check_scope_escape env level ty
with Unify trace ->
raise(Error(loc, env, Pattern_type_clash(trace, None)))
-(* type_pat propagates the expected type as well as maps for
- constructors and labels.
- Unification may update the typing environment. *)
-(* constrs <> None => called from parmatch: backtrack on or-patterns
- explode > 0 => explode Ppat_any for gadts *)
-let rec type_pat ?(exception_allowed=false) ~constrs ~labels ~no_existentials
- ~mode ~explode ~env sp expected_ty k =
+type pattern_checking_mode =
+ | Normal
+ (** We are checking user code. *)
+ | Counter_example of counter_example_checking_info
+ (** In [Counter_example] mode, we are checking a counter-example
+ candidate produced by Parmatch. This is a syntactic pattern that
+ represents a set of values by using or-patterns (p_1 | ... | p_n)
+ to enumerate all alternatives in the counter-example
+ search. These or-patterns occur at every choice point, possibly
+ deep inside the pattern.
+
+ Parmatch does not use type information, so this pattern may
+ exhibit two issues:
+ - some parts of the pattern may be ill-typed due to GADTs, and
+ - some wildcard patterns may not match any values: their type is
+ empty.
+
+ The aim of [type_pat] in the [Counter_example] mode is to refine
+ this syntactic pattern into a well-typed pattern, and ensure
+ that it matches at least one concrete value.
+ - It filters ill-typed branches of or-patterns.
+ (see {!splitting_mode} below)
+ - It tries to check that wildcard patterns are non-empty.
+ (see {!explosion_fuel})
+ *)
+
+and counter_example_checking_info = {
+ explosion_fuel: int;
+ splitting_mode: splitting_mode;
+ constrs: (string, Types.constructor_description) Hashtbl.t;
+ labels: (string, Types.label_description) Hashtbl.t;
+ }
+(**
+ [explosion_fuel] controls the checking of wildcard patterns. We
+ eliminate potentially-empty wildcard patterns by exploding them
+ into concrete sub-patterns, for example (K1 _ | K2 _) or
+ { l1: _; l2: _ }. [explosion_fuel] is the depth limit on wildcard
+ explosion. Such depth limit is required to avoid non-termination
+ and compilation-time blowups.
+
+ [splitting_mode] controls the handling of or-patterns. In
+ [Counter_example] mode, we only need to select one branch that
+ leads to a well-typed pattern. Checking all branches is expensive,
+ we use different search strategies (see {!splitting_mode}) to
+ reduce the number of explored alternatives.
+
+ [constrs] and [labels] contain metadata produced by [Parmatch] to
+ type-check the given syntactic pattern. [Parmatch] produces
+ counter-examples by turning typed patterns into
+ [Parsetree.pattern]. In this process, constructor and label paths
+ are lost, and are replaced by generated strings. [constrs] and
+ [labels] map those synthetic names back to the typed descriptions
+ of the original names.
+ *)
+
+(** Due to GADT constraints, an or-pattern produced within
+ a counter-example may have ill-typed branches. Consider for example
+
+ type _ tag = Int : int tag | Bool : bool tag
+
+ then [Parmatch] will propose the or-pattern [Int | Bool] whenever
+ a pattern of type [tag] is required to form a counter-example. For
+ example, a function expects a (int tag option) and only [None] is
+ handled by the user-written pattern. [Some (Int | Bool)] is not
+ well-typed in this context, only the sub-pattern [Some Int] is.
+ In this example, the expected type coming from the context
+ suffices to know which or-pattern branch must be chosen.
+
+ In the general case, choosing a branch can have non-local effects
+ on the typability of the term. For example, consider a tuple type
+ ['a tag * ...'a...], where the first component is a GADT. All
+ constructor choices for this GADT lead to a well-typed branch in
+ isolation (['a] is unconstrained), but choosing one of them adds
+ a constraint on ['a] that may make the other tuple elements
+ ill-typed.
+
+ In general, after choosing each possible branch of the or-pattern,
+ [type_pat] has to check the rest of the pattern to tell if this
+ choice leads to a well-typed term. This may lead to an explosion
+ of typing/search work -- the rest of the term may in turn contain
+ alternatives.
+
+ We use careful strategies to try to limit counterexample-checking
+ time; [splitting_mode] represents those strategies.
+*)
+and splitting_mode =
+ | Backtrack_or
+ (** Always backtrack in or-patterns.
+
+ [Backtrack_or] selects a single alternative from an or-pattern
+ by using backtracking, trying to choose each branch in turn, and
+ to complete it into a valid sub-pattern. We call this
+ "splitting" the or-pattern.
+
+ We use this mode when looking for unused patterns or sub-patterns,
+ in particular to check a refutation clause (p -> .).
+ *)
+ | Refine_or of { inside_nonsplit_or: bool; }
+ (** Only backtrack when needed.
+
+ [Refine_or] tries another approach for refining or-pattern.
+
+ Instead of always splitting each or-pattern, It first attempts to
+ find branches that do not introduce new constraints (because they
+ do not contain GADT constructors). Those branches are such that,
+ if they fail, all other branches will fail.
+
+ If we find one such branch, we attempt to complete the subpattern
+ (checking what's outside the or-pattern), ignoring other
+ branches -- we never consider another branch choice again. If all
+ branches are constrained, it falls back to splitting the
+ or-pattern.
+
+ We use this mode when checking exhaustivity of pattern matching.
+ *)
+
+(** This exception is only used internally within [type_pat_aux], to jump
+ back to the parent or-pattern in the [Refine_or] strategy.
+
+ Such a parent exists precisely when [inside_nonsplit_or = true];
+ it's an invariant that we always setup an exception handler for
+ [Need_backtrack] when we set this flag. *)
+ exception Need_backtrack
+
+(** Remember current typing state for backtracking.
+ No variable information, as we only backtrack on
+ patterns without variables (cf. assert statements). *)
+type state =
+ { snapshot: Btype.snapshot;
+ levels: Ctype.levels;
+ env: Env.t; }
+let save_state env =
+ { snapshot = Btype.snapshot ();
+ levels = Ctype.save_levels ();
+ env = !env; }
+let set_state s env =
+ Btype.backtrack s.snapshot;
+ Ctype.set_levels s.levels;
+ env := s.env
+
+(** Find the first alternative in the tree of or-patterns for which
+ [f] does not raise an error. If all fail, the last error is
+ propagated *)
+let rec find_valid_alternative f pat =
+ match pat.ppat_desc with
+ | Ppat_or(p1,p2) ->
+ (try find_valid_alternative f p1
+ with Error _ -> find_valid_alternative f p2)
+ | _ -> f pat
+
+let no_explosion = function
+ | Normal -> Normal
+ | Counter_example info ->
+ Counter_example { info with explosion_fuel = 0 }
+
+let get_splitting_mode = function
+ | Normal -> None
+ | Counter_example {splitting_mode} -> Some splitting_mode
+
+let enter_nonsplit_or mode = match mode with
+ | Normal -> Normal
+ | Counter_example info ->
+ let splitting_mode = match info.splitting_mode with
+ | Backtrack_or ->
+ (* in Backtrack_or mode, or-patterns are always split *)
+ assert false
+ | Refine_or _ ->
+ Refine_or {inside_nonsplit_or = true}
+ in Counter_example { info with splitting_mode }
+
+let rec type_pat ?(exception_allowed=false) ~no_existentials ~mode
+ ~env sp expected_ty k =
Builtin_attributes.warning_scope sp.ppat_attributes
(fun () ->
- type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode
- ~explode ~env sp expected_ty k
+ type_pat_aux ~exception_allowed ~no_existentials ~mode
+ ~env sp expected_ty k
)
-and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode
- ~explode ~env sp expected_ty k =
- let mode' = if mode = Splitting_or then Normal else mode in
- let type_pat ?(exception_allowed=false) ?(constrs=constrs) ?(labels=labels)
- ?(mode=mode') ?(explode=explode) ?(env=env) =
- type_pat ~exception_allowed ~constrs ~labels ~no_existentials ~mode ~explode
- ~env
+and type_pat_aux ~exception_allowed ~no_existentials ~mode
+ ~env sp expected_ty k =
+ let type_pat ?(exception_allowed=false) ?(mode=mode) ?(env=env) =
+ type_pat ~exception_allowed ~no_existentials ~mode ~env
in
let loc = sp.ppat_loc in
+ let refine = match mode with Normal -> false | Counter_example _ -> true in
let rup k x =
- if constrs = None then (ignore (rp x));
- unify_pat !env x (instance expected_ty);
+ if mode = Normal then (ignore (rp x));
+ unify_pat ~refine env x (instance expected_ty);
k x
in
- let rp k x : pattern = if constrs = None then k (rp x) else k x in
+ let rp k x : pattern = if mode = Normal then k (rp x) else k x in
+ let construction_not_used_in_counterexamples = (mode = Normal) in
+ let must_backtrack_on_gadt = match get_splitting_mode mode with
+ | None -> false
+ | Some Backtrack_or -> false
+ | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or
+ in
match sp.ppat_desc with
Ppat_any ->
let k' d = rp k {
pat_attributes = sp.ppat_attributes;
pat_env = !env }
in
- if explode > 0 then
- let (sp, constrs, labels) =
- try
- Parmatch.ppat_of_type !env expected_ty
- with Parmatch.Empty -> raise (Error (loc, !env, Empty_pattern))
- in
- if sp.ppat_desc = Parsetree.Ppat_any then k' Tpat_any else
- if mode = Inside_or then raise Need_backtrack else
- let explode =
- match sp.ppat_desc with
- Parsetree.Ppat_or _ -> explode - 5
- | _ -> explode - 1
- in
- type_pat ~constrs:(Some constrs) ~labels:(Some labels)
- ~explode sp expected_ty k
- else k' Tpat_any
+ begin match mode with
+ | Normal -> k' Tpat_any
+ | Counter_example {explosion_fuel; _} when explosion_fuel <= 0 ->
+ k' Tpat_any
+ | Counter_example ({explosion_fuel; _} as info) ->
+ begin match Parmatch.ppat_of_type !env expected_ty with
+ | exception Parmatch.Empty -> raise (Error (loc, !env, Empty_pattern))
+ | (sp, constrs, labels) ->
+ if sp.ppat_desc = Parsetree.Ppat_any then k' Tpat_any else
+ if must_backtrack_on_gadt then raise Need_backtrack else
+ let explosion_fuel =
+ match sp.ppat_desc with
+ Parsetree.Ppat_or _ -> explosion_fuel - 5
+ | _ -> explosion_fuel - 1
+ in
+ let mode =
+ Counter_example { info with explosion_fuel; constrs; labels }
+ in
+ type_pat ~mode sp expected_ty k
+ end
+ end
| Ppat_var name ->
let ty = instance expected_ty in
let id = (* PR#7330 *)
pat_attributes = sp.ppat_attributes;
pat_env = !env }
| Ppat_unpack name ->
- assert (constrs = None);
+ assert construction_not_used_in_counterexamples;
let t = instance expected_ty in
- let id = enter_variable loc name t ~is_module:true sp.ppat_attributes in
- rp k {
- pat_desc = Tpat_var (id, name);
- pat_loc = sp.ppat_loc;
- pat_extra=[Tpat_unpack, loc, sp.ppat_attributes];
- pat_type = t;
- pat_attributes = [];
- pat_env = !env }
+ begin match name.txt with
+ | None ->
+ rp k {
+ pat_desc = Tpat_any;
+ pat_loc = sp.ppat_loc;
+ pat_extra=[Tpat_unpack, name.loc, sp.ppat_attributes];
+ pat_type = t;
+ pat_attributes = [];
+ pat_env = !env }
+ | Some s ->
+ let v = { name with txt = s } in
+ let id = enter_variable loc v t ~is_module:true sp.ppat_attributes in
+ rp k {
+ pat_desc = Tpat_var (id, v);
+ pat_loc = sp.ppat_loc;
+ pat_extra=[Tpat_unpack, loc, sp.ppat_attributes];
+ pat_type = t;
+ pat_attributes = [];
+ pat_env = !env }
+ end
| Ppat_constraint(
{ppat_desc=Ppat_var name; ppat_loc=lloc; ppat_attributes = attrs},
({ptyp_desc=Ptyp_poly _} as sty)) ->
(* explicitly polymorphic type *)
- assert (constrs = None);
+ assert construction_not_used_in_counterexamples;
let cty, force = Typetexp.transl_simple_type_delayed !env sty in
let ty = cty.ctyp_type in
- unify_pat_types lloc !env ty (instance expected_ty);
+ unify_pat_types ~refine lloc env ty (instance expected_ty);
pattern_force := force :: !pattern_force;
begin match ty.desc with
| Tpoly (body, tyl) ->
| _ -> assert false
end
| Ppat_alias(sq, name) ->
- assert (constrs = None);
+ assert construction_not_used_in_counterexamples;
type_pat sq expected_ty (fun q ->
begin_def ();
- let ty_var = build_as_type !env q in
+ let ty_var = build_as_type env q in
end_def ();
generalize ty_var;
let id =
in
let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
let p = {p with ppat_loc=loc} in
- type_pat ~explode:0 p expected_ty k
+ type_pat ~mode:(no_explosion mode) p expected_ty k
(* TODO: record 'extra' to remember about interval *)
| Ppat_interval _ ->
raise (Error (loc, !env, Invalid_interval))
let expected_ty = instance expected_ty in
end_def ();
generalize_structure expected_ty;
- unify_pat_types loc !env ty expected_ty;
+ unify_pat_types ~refine loc env ty expected_ty;
map_fold_cont (fun (p,t) -> type_pat p t) spl_ann (fun pl ->
rp k {
pat_desc = Tpat_tuple pl;
Some (p0, p, true)
with Not_found -> None
in
- let candidates =
- match lid.txt, constrs with
- Longident.Lident s, Some constrs when Hashtbl.mem constrs s ->
- [Hashtbl.find constrs s, (fun () -> ())]
- | _ -> Typetexp.find_all_constructors !env lid.loc lid.txt
- in
let constr =
+ match lid.txt, mode with
+ | Longident.Lident s, Counter_example {constrs; _} ->
+ (* assert: cf. {!counter_example_checking_info} documentation *)
+ assert (Hashtbl.mem constrs s);
+ Hashtbl.find constrs s
+ | _ ->
+ let candidates =
+ Env.lookup_all_constructors Env.Pattern ~loc:lid.loc lid.txt !env in
wrap_disambiguate "This variant pattern is expected to have"
(mk_expected expected_ty)
- (Constructor.disambiguate lid !env opath) candidates
+ (Constructor.disambiguate Env.Pattern lid !env opath) candidates
in
- if constr.cstr_generalized && constrs <> None && mode = Inside_or
- then raise Need_backtrack;
- Env.mark_constructor Env.Pattern !env (Longident.last lid.txt) constr;
- Builtin_attributes.check_alerts loc constr.cstr_attributes
- constr.cstr_name;
+ if constr.cstr_generalized && must_backtrack_on_gadt then
+ raise Need_backtrack;
begin match no_existentials, constr.cstr_existentials with
| None, _ | _, [] -> ()
| Some r, (_ :: _ as exs) ->
(* if constructor is gadt, we must verify that the expected type has the
correct head *)
if constr.cstr_generalized then
- unify_head_only loc !env (instance expected_ty) constr;
+ unify_head_only ~refine loc env (instance expected_ty) constr;
let sargs =
match sarg with
None -> []
in
let expected_ty = instance expected_ty in
(* PR#7214: do not use gadt unification for toplevel lets *)
- if not constr.cstr_generalized || no_existentials <> None
- then unify_pat_types loc !env ty_res expected_ty
- else unify_pat_types_gadt loc env ty_res expected_ty;
+ unify_pat_types loc env ty_res expected_ty
+ ~refine:(refine || constr.cstr_generalized && no_existentials = None);
end_def ();
generalize_structure expected_ty;
generalize_structure ty_res;
row_bound = ();
row_closed = false;
row_more = newgenvar ();
- row_fixed = false;
+ row_fixed = None;
row_name = None } in
begin_def ();
let expected_ty = instance expected_ty in
generalize_structure expected_ty;
(* PR#7404: allow some_private_tag blindly, as it would not unify with
the abstract row variable *)
- if l = Parmatch.some_private_tag then assert (constrs <> None)
- else unify_pat_types loc !env (newgenty (Tvariant row)) expected_ty;
+ if l = Parmatch.some_private_tag
+ then assert (match mode with Normal -> false | Counter_example _ -> true)
+ else unify_pat_types ~refine loc env (newgenty(Tvariant row)) expected_ty;
let k arg =
rp k {
pat_desc = Tpat_variant(l, arg, ref {row with row_more = newvar()});
begin_def ();
let (_, ty_arg, ty_res) = instance_label false label in
begin try
- unify_pat_types loc !env ty_res (instance record_ty)
+ unify_pat_types ~refine loc env ty_res (instance record_ty)
with Error(_loc, _env, Pattern_type_clash(trace, _)) ->
raise(Error(label_lid.loc, !env,
Label_mismatch(label_lid.txt, trace)))
pat_attributes = sp.ppat_attributes;
pat_env = !env }
in
- if constrs = None then
- k (wrap_disambiguate "This record pattern is expected to have"
- (mk_expected expected_ty)
- (type_label_a_list ?labels loc false !env type_label_pat opath
- lid_sp_list)
- (k' (fun x -> x)))
- else
- type_label_a_list ?labels loc false !env type_label_pat opath
- lid_sp_list (k' k)
+ begin match mode with
+ | Normal ->
+ k (wrap_disambiguate "This record pattern is expected to have"
+ (mk_expected expected_ty)
+ (type_label_a_list loc false !env type_label_pat opath
+ lid_sp_list)
+ (k' (fun x -> x)))
+ | Counter_example {labels; _} ->
+ type_label_a_list ~labels loc false !env type_label_pat opath
+ lid_sp_list (k' k)
+ end
| Ppat_array spl ->
let ty_elt = newgenvar() in
begin_def ();
let expected_ty = instance expected_ty in
end_def ();
generalize_structure expected_ty;
- unify_pat_types
- loc !env (Predef.type_array ty_elt) expected_ty;
+ unify_pat_types ~refine
+ loc env (Predef.type_array ty_elt) expected_ty;
map_fold_cont (fun p -> type_pat p ty_elt) spl (fun pl ->
rp k {
pat_desc = Tpat_array pl;
pat_attributes = sp.ppat_attributes;
pat_env = !env })
| Ppat_or(sp1, sp2) ->
+ let may_split, must_split =
+ match get_splitting_mode mode with
+ | None -> false, false
+ | Some Backtrack_or -> true, true
+ | Some (Refine_or _) -> true, false in
let state = save_state env in
- begin match
- if mode = Split_or || mode = Splitting_or then raise Need_backtrack;
+ let split_or sp =
+ assert may_split;
+ let typ pat = type_pat ~exception_allowed pat expected_ty k in
+ find_valid_alternative (fun pat -> set_state state env; typ pat) sp in
+ if must_split then split_or sp else begin
let initial_pattern_variables = !pattern_variables in
let initial_module_variables = !module_variables in
let equation_level = !gadt_equations_level in
let lev = get_current_level () in
gadt_equations_level := Some lev;
let env1 = ref !env in
+ let inside_or = enter_nonsplit_or mode in
let p1 =
- try Some (type_pat ~exception_allowed ~mode:Inside_or sp1 expected_ty
- ~env:env1 (fun x -> x))
+ try Some (type_pat ~exception_allowed ~mode:inside_or
+ sp1 expected_ty ~env:env1 (fun x -> x))
with Need_backtrack -> None in
let p1_variables = !pattern_variables in
let p1_module_variables = !module_variables in
module_variables := initial_module_variables;
let env2 = ref !env in
let p2 =
- try Some (type_pat ~exception_allowed ~mode:Inside_or sp2 expected_ty
- ~env:env2 (fun x -> x))
+ try Some (type_pat ~exception_allowed ~mode:inside_or
+ sp2 expected_ty ~env:env2 (fun x -> x))
with Need_backtrack -> None in
end_def ();
gadt_equations_level := equation_level;
List.iter (fun { pv_type; pv_loc; _ } ->
check_scope_escape pv_loc !env2 outter_lev pv_type
) p2_variables;
- match p1, p2 with
- None, None -> raise Need_backtrack
- | Some p, None | None, Some p -> p (* no variables in this case *)
+ begin match p1, p2 with
+ | None, None ->
+ let inside_nonsplit_or =
+ match get_splitting_mode mode with
+ | None | Some Backtrack_or -> false
+ | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or in
+ if inside_nonsplit_or
+ then raise Need_backtrack
+ else split_or sp
+ | Some p, None | None, Some p -> rp k p (* no variables in this case *)
| Some p1, Some p2 ->
let alpha_env =
enter_orpat_variables loc !env p1_variables p2_variables in
pattern_variables := p1_variables;
module_variables := p1_module_variables;
- { pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
- pat_loc = loc; pat_extra=[];
- pat_type = instance expected_ty;
- pat_attributes = sp.ppat_attributes;
- pat_env = !env }
- with
- p -> rp k p
- | exception Need_backtrack when mode <> Inside_or ->
- assert (constrs <> None);
- set_state state env;
- let mode =
- if mode = Split_or then mode else Splitting_or in
- try type_pat ~exception_allowed ~mode sp1 expected_ty k
- with Error _ ->
- set_state state env;
- type_pat ~exception_allowed ~mode sp2 expected_ty k
+ rp k { pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
+ pat_loc = loc;
+ pat_extra=[];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !env }
+ end
end
| Ppat_lazy sp1 ->
let nv = newgenvar () in
- unify_pat_types loc !env (Predef.type_lazy_t nv) expected_ty;
+ unify_pat_types ~refine loc env (Predef.type_lazy_t nv) expected_ty;
(* do not explode under lazy: PR#7421 *)
- type_pat ~explode:0 sp1 nv (fun p1 ->
+ type_pat ~mode:(no_explosion mode) sp1 nv (fun p1 ->
rp k {
pat_desc = Tpat_lazy p1;
pat_loc = loc; pat_extra=[];
end_def();
generalize_structure ty;
let ty, expected_ty' = instance ty, ty in
- unify_pat_types loc !env ty (instance expected_ty);
+ unify_pat_types ~refine loc env ty (instance expected_ty);
type_pat ~exception_allowed sp expected_ty' (fun p ->
(*Format.printf "%a@.%a@."
Printtyp.raw_type_expr ty
in k p)
| Ppat_type lid ->
let (path, p,ty) = build_or_pat !env loc lid in
- unify_pat_types loc !env ty (instance expected_ty);
+ unify_pat_types ~refine loc env ty (instance expected_ty);
k { p with pat_extra =
(Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra }
| Ppat_open (lid,p) ->
if not exception_allowed then
raise (Error (loc, !env, Exception_pattern_disallowed))
else begin
- let p_exn = type_pat p Predef.type_exn k in
+ type_pat p Predef.type_exn (fun p_exn ->
rp k {
pat_desc = Tpat_exception p_exn;
pat_loc = sp.ppat_loc;
pat_type = expected_ty;
pat_env = !env;
pat_attributes = sp.ppat_attributes;
- }
+ })
end
| Ppat_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
-let type_pat ?exception_allowed ?no_existentials ?constrs ?labels ?(mode=Normal)
- ?(explode=0) ?(lev=get_current_level()) env sp expected_ty =
+let type_pat ?exception_allowed ?no_existentials ?(mode=Normal)
+ ?(lev=get_current_level()) env sp expected_ty =
Misc.protect_refs [Misc.R (gadt_equations_level, Some lev)] (fun () ->
let r =
- type_pat ?exception_allowed ~no_existentials ~constrs ~labels ~mode
- ~explode ~env sp expected_ty (fun x -> x)
+ type_pat ?exception_allowed ~no_existentials ~mode
+ ~env sp expected_ty (fun x -> x)
in
iter_pattern (fun p -> p.pat_env <- !env) r;
r
(* this function is passed to Partial.parmatch
to type check gadt nonexhaustiveness *)
-let partial_pred ~lev ?mode ?explode env expected_ty constrs labels p =
+let partial_pred ~lev ~splitting_mode ?(explode=0)
+ env expected_ty constrs labels p =
let env = ref env in
let state = save_state env in
+ let mode =
+ Counter_example {
+ splitting_mode;
+ explosion_fuel = explode;
+ constrs; labels;
+ } in
try
reset_pattern None true;
let typed_p =
- Ctype.with_passive_variants
- (type_pat ~lev ~constrs ~labels ?mode ?explode env p)
- expected_ty
+ Ctype.with_passive_variants (type_pat ~lev ~mode env p) expected_ty
in
set_state state env;
(* types are invalidated but we don't need them here *)
let check_partial ?(lev=get_current_level ()) env expected_ty loc cases =
let explode = match cases with [_] -> 5 | _ -> 0 in
+ let splitting_mode = Refine_or {inside_nonsplit_or = false} in
Parmatch.check_partial
- (partial_pred ~lev ~explode env expected_ty) loc cases
+ (partial_pred ~lev ~splitting_mode ~explode env expected_ty) loc cases
let check_unused ?(lev=get_current_level ()) env expected_ty cases =
Parmatch.check_unused
(fun refute constrs labels spat ->
match
- partial_pred ~lev ~mode:Split_or ~explode:5
+ partial_pred ~lev ~splitting_mode:Backtrack_or ~explode:5
env expected_ty constrs labels spat
with
Some pat when refute ->
iter_pattern finalize_variant pat
end;
List.iter (fun f -> f()) (get_ref pattern_force);
- if is_optional l then unify_pat val_env pat (type_option (newvar ()));
+ if is_optional l then unify_pat (ref val_env) pat (type_option (newvar ()));
let (pv, met_env) =
List.fold_right
(fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} (pv, env) ->
List.fold_right
(fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes}
(val_env, met_env, par_env) ->
- (Env.add_value pv_id {val_type = pv_type;
- val_kind =
- Val_unbound Val_unbound_instance_variable;
- val_attributes = pv_attributes;
- Types.val_loc = pv_loc;
- } val_env,
+ let name = Ident.name pv_id in
+ (Env.enter_unbound_value name Val_unbound_self val_env,
Env.add_value pv_id {val_type = pv_type;
val_kind =
Val_self (meths, vars, cl_num, privty);
~check:(fun s -> if pv_as_var then Warnings.Unused_var s
else Warnings.Unused_var_strict s)
met_env,
- Env.add_value pv_id {val_type = pv_type;
- val_kind =
- Val_unbound Val_unbound_instance_variable;
- val_attributes = pv_attributes;
- Types.val_loc = pv_loc;
- } par_env))
+ Env.enter_unbound_value name Val_unbound_self par_env))
pv (val_env, met_env, par_env)
in
(pat, meths, vars, val_env, met_env, par_env)
reset_delayed_checks ();
Btype.backtrack snap
-let rec final_subexpression sexp =
- match sexp.pexp_desc with
- Pexp_let (_, _, e)
- | Pexp_sequence (_, e)
- | Pexp_try (e, _)
- | Pexp_ifthenelse (_, e, _)
- | Pexp_match (_, {pc_rhs=e} :: _)
+let rec final_subexpression exp =
+ match exp.exp_desc with
+ Texp_let (_, _, e)
+ | Texp_sequence (_, e)
+ | Texp_try (e, _)
+ | Texp_ifthenelse (_, e, _)
+ | Texp_match (_, {c_rhs=e} :: _, _)
+ | Texp_letmodule (_, _, _, _, e)
+ | Texp_letexception (_, e)
+ | Texp_open (_, e)
-> final_subexpression e
- | _ -> sexp
+ | _ -> exp
(* Generalization criterion for expressions *)
| Ptyp_tuple args ->
newty (Ttuple (List.map (approx_type env) args))
| Ptyp_constr (lid, ctl) ->
- begin try
- let path = Env.lookup_type lid.txt env in
- let decl = Env.find_type path env in
- if List.length ctl <> decl.type_arity then raise Not_found;
+ let path, decl = Env.lookup_type ~use:false ~loc:lid.loc lid.txt env in
+ if List.length ctl <> decl.type_arity then newvar ()
+ else begin
let tyl = List.map (approx_type env) ctl in
newconstr path tyl
- with Not_found -> newvar ()
end
| Ptyp_poly (_, sty) ->
approx_type env sty
generalize t;
match t.desc with
Tvar name when t.level = generic_level ->
- log_type t; t.desc <- Tunivar name; true
+ set_type_desc t (Tunivar name); true
| _ -> false)
vars in
if List.length vars = List.length vars' then () else
let open Ast_helper in
List.fold_left
(fun sexp (name, loc) ->
- Exp.letmodule ~loc:sexp.pexp_loc
+ Exp.letmodule ~loc:{ sexp.pexp_loc with loc_ghost = true }
~attrs:[Attr.mk (mknoloc "#modulepat") (PStr [])]
- name
+ { name with txt = Some name.txt }
(Mod.unpack ~loc
(Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt)
name.loc)))
match ty.desc with
Tvariant row ->
let row = row_repr row in
- if not row.row_fixed then
+ if not (is_fixed row) then
List.iter
(fun (_,f) ->
match row_field_repr f with Reither _ -> raise Exit | _ -> ())
try loop ty; unmark_type ty; false
with Exit -> unmark_type ty; true
-let iter_ppat f p =
+let shallow_iter_ppat f p =
match p.ppat_desc with
| Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _
| Ppat_extension _
| Ppat_type _ | Ppat_unpack _ -> ()
| Ppat_array pats -> List.iter f pats
| Ppat_or (p1,p2) -> f p1; f p2
- | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> may f arg
+ | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> Option.iter f arg
| Ppat_tuple lst -> List.iter f lst
| Ppat_exception p | Ppat_alias (p,_)
| Ppat_open (_,p)
| Ppat_constraint (p,_) | Ppat_lazy p -> f p
| Ppat_record (args, _flag) -> List.iter (fun (_,p) -> f p) args
-let contains_polymorphic_variant p =
+let exists_ppat f p =
+ let exception Found in
let rec loop p =
- match p.ppat_desc with
- Ppat_variant _ | Ppat_type _ -> raise Exit
- | _ -> iter_ppat loop p
- in
- try loop p; false with Exit -> true
+ if f p then raise Found else ();
+ shallow_iter_ppat loop p in
+ match loop p with
+ | exception Found -> true
+ | () -> false
-let contains_gadt p =
- let check p =
- match p.pat_desc with
- | Tpat_construct (_, cd, _) when cd.cstr_generalized ->
- raise Exit
- | _ -> ()
- in
- try iter_pattern check p; false with Exit -> true
+let contains_polymorphic_variant p =
+ exists_ppat
+ (function
+ | {ppat_desc = (Ppat_variant _ | Ppat_type _)} -> true
+ | _ -> false)
+ p
+
+let contains_gadt cp =
+ exists_pattern
+ (function
+ | {pat_desc = Tpat_construct (_, cd, _)} when cd.cstr_generalized -> true
+ | _ -> false)
+ cp
(* There are various things that we need to do in presence of GADT constructors
that aren't required if there are none.
patterns contain some GADT constructors. So we conservatively assume that
any constructor might be a GADT constructor. *)
let may_contain_gadts p =
- let rec loop p =
- match p.ppat_desc with
- | Ppat_construct (_, _) -> raise Exit
- | _ -> iter_ppat loop p
- in
- try loop p; false with Exit -> true
+ exists_ppat
+ (function
+ | {ppat_desc = Ppat_construct (_, _)} -> true
+ | _ -> false)
+ p
let check_absent_variant env =
iter_pattern
let row = row_repr !row in
if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent)
row.row_fields
- || not row.row_fixed && not (static_row row) (* same as Ctype.poly *)
+ || not (is_fixed row) && not (static_row row) (* same as Ctype.poly *)
then () else
let ty_arg =
match arg with None -> [] | Some p -> [correct_levels p.pat_type] in
let row' = {row_fields = [s, Reither(arg=None,ty_arg,true,ref None)];
row_more = newvar (); row_bound = ();
- row_closed = false; row_fixed = false; row_name = None} in
+ row_closed = false; row_fixed = None; row_name = None} in
(* Should fail *)
- unify_pat env {pat with pat_type = newty (Tvariant row')}
- (correct_levels pat.pat_type)
+ unify_pat (ref env) {pat with pat_type = newty (Tvariant row')}
+ (correct_levels pat.pat_type)
| _ -> ())
-(* Duplicate types of values in the environment *)
-(* XXX Should we do something about global type variables too? *)
-
-let duplicate_ident_types half_typed_cases env =
- let caselist =
- List.filter (fun { typed_pat; _ } ->
- contains_gadt typed_pat
- ) half_typed_cases
- in
- Env.make_copy_of_types (all_idents_cases caselist) env
-
(* Getting proper location of already typed expressions.
Used to avoid confusing locations on type error messages in presence of
match desc.val_kind with
| Val_ivar (_, cl_num) ->
let (self_path, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.find_value_by_name
+ (Longident.Lident ("self-" ^ cl_num)) env
in
Texp_instvar(self_path, path,
match lid.txt with
| _ -> assert false)
| Val_self (_, _, cl_num, _) ->
let (path, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
in
Texp_ident(path, lid, desc)
- | Val_unbound Val_unbound_instance_variable ->
- raise(Error(loc, env, Masked_instance_variable lid.txt))
- | Val_unbound Val_unbound_ghost_recursive ->
- let desc_loc = desc.Types.val_loc in
- (* Only display the "missing rec" hint for non-ghost code *)
- if not loc.Location.loc_ghost
- && not desc_loc.Location.loc_ghost
- then
- raise Typetexp.(Error (
- loc, env, Unbound_value_missing_rec (lid.txt, desc_loc)
- ))
- else
- raise Typetexp.(Error (loc, env, Unbound_value lid.txt))
| _ ->
Texp_ident(path, lid, desc)
in
end
| _ -> raise Not_found
with Not_found ->
- let arg = may_map (type_exp env) sarg in
- let arg_type = may_map (fun arg -> arg.exp_type) arg in
+ let arg = Option.map (type_exp env) sarg in
+ let arg_type = Option.map (fun arg -> arg.exp_type) arg in
rue {
exp_desc = Texp_variant(l, arg);
exp_loc = loc; exp_extra = [];
row_more = newvar ();
row_bound = ();
row_closed = false;
- row_fixed = false;
+ row_fixed = None;
row_name = None});
exp_attributes = sexp.pexp_attributes;
exp_env = env }
unify_exp env record ty_record;
if label.lbl_mut = Immutable then
raise(Error(loc, env, Label_not_mutable lid.txt));
- Builtin_attributes.check_deprecated_mutable lid.loc label.lbl_attributes
- (Longident.last lid.txt);
rue {
exp_desc = Texp_setfield(record, label_loc, label, newval);
exp_loc = loc; exp_extra = [];
end
in
begin match
- Env.lookup_value (Longident.Lident ("selfpat-" ^ cl_num)) env,
- Env.lookup_value (Longident.Lident ("self-" ^cl_num)) env
+ Env.find_value_by_name
+ (Longident.Lident ("selfpat-" ^ cl_num)) env,
+ Env.find_value_by_name
+ (Longident.Lident ("self-" ^cl_num)) env
with
- (_, ({val_kind = Val_self (meths, _, _, privty)} as desc)),
+ | (_, ({val_kind = Val_self (meths, _, _, privty)} as desc)),
(path, _) ->
obj_meths := Some meths;
let (_, typ) =
Undefined_method (obj.exp_type, met, valid_methods)))
end
| Pexp_new cl ->
- let (cl_path, cl_decl) = Typetexp.find_class env cl.loc cl.txt in
+ let (cl_path, cl_decl) = Env.lookup_class ~loc:cl.loc cl.txt env in
begin match cl_decl.cty_new with
None ->
raise(Error(loc, env, Virtual_class cl.txt))
exp_attributes = sexp.pexp_attributes;
exp_env = env }
end
- | Pexp_setinstvar (lab, snewval) ->
- begin try
- let (path, desc) = Env.lookup_value (Longident.Lident lab.txt) env in
- match desc.val_kind with
- Val_ivar (Mutable, cl_num) ->
- let newval =
- type_expect env snewval (mk_expected (instance desc.val_type))
- in
- let (path_self, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
- in
- rue {
- exp_desc = Texp_setinstvar(path_self, path, lab, newval);
- exp_loc = loc; exp_extra = [];
- exp_type = instance Predef.type_unit;
- exp_attributes = sexp.pexp_attributes;
- exp_env = env }
- | Val_ivar _ ->
- raise(Error(loc, env, Instance_variable_not_mutable(true,lab.txt)))
- | _ ->
- raise(Error(loc, env, Instance_variable_not_mutable(false,lab.txt)))
- with
- Not_found ->
- let collect_vars name _path val_desc li =
- match val_desc.val_kind with
- | Val_ivar (Mutable, _) -> name::li
- | _ -> li in
- let valid_vars = Env.fold_values collect_vars None env [] in
- raise(Error(loc, env,
- Unbound_instance_variable (lab.txt, valid_vars)))
- end
+ | Pexp_setinstvar (lab, snewval) -> begin
+ let (path, mut, cl_num, ty) =
+ Env.lookup_instance_variable ~loc lab.txt env
+ in
+ match mut with
+ | Mutable ->
+ let newval =
+ type_expect env snewval (mk_expected (instance ty))
+ in
+ let (path_self, _) =
+ Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ rue {
+ exp_desc = Texp_setinstvar(path_self, path, lab, newval);
+ exp_loc = loc; exp_extra = [];
+ exp_type = instance Predef.type_unit;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
+ | _ ->
+ raise(Error(loc, env, Instance_variable_not_mutable lab.txt))
+ end
| Pexp_override lst ->
let _ =
List.fold_right
[] in
begin match
try
- Env.lookup_value (Longident.Lident "selfpat-*") env,
- Env.lookup_value (Longident.Lident "self-*") env
+ Env.find_value_by_name (Longident.Lident "selfpat-*") env,
+ Env.find_value_by_name (Longident.Lident "self-*") env
with Not_found ->
raise(Error(loc, env, Outside_class))
with
| _ -> Mp_present
in
let scope = create_scope () in
+ let md =
+ { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc }
+ in
let (id, new_env) =
- Env.enter_module ~scope name.txt pres modl.mod_type env
+ match name.txt with
+ | None -> None, env
+ | Some name ->
+ let id, env = Env.enter_module_declaration ~scope name pres md env in
+ Some id, env
in
Typetexp.widen context;
(* ideally, we should catch Expr_type_clash errors
type_expansion_scope = Btype.lowest_level;
type_loc = loc;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
in
Pstr_eval ({ pexp_desc = Pexp_construct (lid, None); _ }, _)
} ] ->
let path =
- match (Typetexp.find_constructor env lid.loc lid.txt).cstr_tag with
+ let cd =
+ Env.lookup_constructor Env.Positive ~loc:lid.loc lid.txt env
+ in
+ match cd.cstr_tag with
| Cstr_extension (path, _) -> path
| _ -> raise (Error (lid.loc, env, Not_an_extension_constructor))
in
exp_env = env }
and type_ident env ?(recarg=Rejected) lid =
- let (path, desc) = Typetexp.find_value env lid.loc lid.txt in
+ let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
if !Clflags.annotations then begin
let dloc = desc.Types.val_loc in
let annot =
let path, desc = type_ident env lid in
let path =
match desc.val_kind with
- | Val_ivar _ | Val_unbound Val_unbound_instance_variable ->
+ | Val_ivar _ ->
fatal_error "Illegal name for instance variable"
| Val_self (_, _, cl_num, _) ->
let path, _ =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
in
path
- | Val_unbound Val_unbound_ghost_recursive ->
- let desc_loc = desc.Types.val_loc in
- (* Only display the "missing rec" hint for non-ghost code *)
- if not loc.Location.loc_ghost
- && not desc_loc.Location.loc_ghost
- then
- raise Typetexp.(Error (
- loc, env, Unbound_value_missing_rec (lid.txt, desc_loc)
- ))
- else
- raise Typetexp.(Error (loc, env, Unbound_value lid.txt))
| _ -> path
in
path, desc
Some(p0, p, (repr ty_exp).level = generic_level || not !Clflags.principal)
with Not_found -> None
in
- let labels = Typetexp.find_all_labels env lid.loc lid.txt in
+ let labels = Env.lookup_all_labels ~loc:lid.loc lid.txt env in
let label =
wrap_disambiguate "This expression has" (mk_expected ty_exp)
- (Label.disambiguate lid env opath) labels in
+ (Label.disambiguate () lid env opath) labels in
(record, label, opath)
(* Typing format strings for printing or reading.
| Float_G -> mk_constr "Float_G" []
| Float_h -> mk_constr "Float_h" []
| Float_H -> mk_constr "Float_H" []
- | Float_F -> mk_constr "Float_F" [] in
+ | Float_F -> mk_constr "Float_F" []
+ | Float_CF -> mk_constr "Float_CF" [] in
mk_exp_loc (Pexp_tuple [flag; kind])
and mk_counter cnt = match cnt with
| Line_counter -> mk_constr "Line_counter" []
arg
with exn when maybe_expansive arg -> try
(* Try to retype without propagating ty_arg, cf PR#4862 *)
- may Btype.backtrack snap;
+ Option.iter Btype.backtrack snap;
begin_def ();
let arg = type_exp env sarg in
end_def ();
let rec make_args args ty_fun =
match (expand_head env ty_fun).desc with
| Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
- let ty = option_none (instance ty_arg) sarg.pexp_loc in
+ let ty = option_none env (instance ty_arg) sarg.pexp_loc in
make_args ((l, Some ty) :: args) ty_fun
| Tarrow (l,_,ty_res',_) when l = Nolabel || !Clflags.classic ->
List.rev args, ty_fun, no_labels ty_res'
else begin
may_warn sarg0.pexp_loc
(Warnings.Not_principal "using an optional argument here");
- Some (fun () -> option_some (type_argument env sarg0
+ Some (fun () -> option_some env (type_argument env sarg0
(extract_option_type env ty)
(extract_option_type env ty0)))
end
may_warn funct.exp_loc
(Warnings.Without_principality "eliminated optional argument");
ignored := (l,ty,lv) :: !ignored;
- Some (fun () -> option_none (instance ty) Location.none)
+ Some (fun () -> option_none env (instance ty) Location.none)
end else begin
may_warn funct.exp_loc
(Warnings.Without_principality "commuted an argument");
Some(p0, p, principal)
with Not_found -> None
in
- let constrs = Typetexp.find_all_constructors env lid.loc lid.txt in
+ let constrs =
+ Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env
+ in
let constr =
wrap_disambiguate "This variant expression is expected to have"
ty_expected_explained
- (Constructor.disambiguate lid env opath) constrs in
- Env.mark_constructor Env.Positive env (Longident.last lid.txt) constr;
- Builtin_attributes.check_alerts loc constr.cstr_attributes
- constr.cstr_name;
+ (Constructor.disambiguate Env.Positive lid env opath) constrs
+ in
let sargs =
match sarg with
None -> []
(* Typing of statements (expressions whose values are discarded) *)
and type_statement ?explanation env sexp =
- let loc = (final_subexpression sexp).pexp_loc in
begin_def();
let exp = type_exp env sexp in
end_def();
let ty = expand_head env exp.exp_type and tv = newvar() in
if is_Tvar ty && ty.level > tv.level then
- Location.prerr_warning loc Warnings.Nonreturning_statement;
+ Location.prerr_warning
+ (final_subexpression exp).exp_loc
+ Warnings.Nonreturning_statement;
if !Clflags.strict_sequence then
let expected_ty = instance Predef.type_unit in
with_explanation explanation (fun () ->
let does_contain_gadt =
List.exists (fun { contains_gadt; _ } -> contains_gadt) half_typed_cases
in
- let ty_res, duplicated_ident_types =
+ let ty_res, do_copy_types =
if does_contain_gadt && not !Clflags.principal then
- correct_levels ty_res, duplicate_ident_types half_typed_cases env
- else ty_res, duplicate_ident_types [] env
+ correct_levels ty_res, Env.make_copy_of_types env
+ else ty_res, (fun env -> env)
in
(* Unify all cases (delayed to keep it order-free) *)
let ty_arg' = newvar () in
let unify_pats ty =
List.iter (fun { typed_pat = pat; pat_type_for_unif = pat_ty; _ } ->
- unify_pat_types pat.pat_loc env pat_ty ty
+ unify_pat_types pat.pat_loc (ref env) pat_ty ty
) half_typed_cases
in
unify_pats ty_arg';
contains_gadt; _ } ->
let ext_env =
if contains_gadt then
- Env.do_copy_types duplicated_ident_types ext_env
+ do_copy_types ext_env
else
ext_env
in
{pat with pat_type =
snd (instance_poly ~keep_names:true false tl ty)}
| _ -> pat
- in unify_pat env pat (type_approx env binding.pvb_expr))
+ in unify_pat (ref env) pat (type_approx env binding.pvb_expr))
pat_list spat_sexp_list;
(* Polymorphic variant processing *)
List.iter
generalize exp.exp_type;
match sexp.pexp_desc with
Pexp_ident lid ->
+ let loc = sexp.pexp_loc in
(* Special case for keeping type variables when looking-up a variable *)
- let (_path, desc) = Env.lookup_value lid.txt env in
+ let (_path, desc) = Env.lookup_value ~use:false ~loc lid.txt env in
{exp with exp_type = desc.val_type}
| _ -> exp
fprintf ppf "but an expression was expected of type");
) ()
| Apply_non_function typ ->
- reset_and_mark_loops typ;
begin match (repr typ).desc with
Tarrow _ ->
Location.errorf ~loc
| Nolabel -> fprintf ppf "without label"
| l -> fprintf ppf "with label %s" (prefixed_label_name l)
in
- reset_and_mark_loops ty;
Location.errorf ~loc
"@[<v>@[<2>The function applied to this argument has type@ %a@]@.\
This argument cannot be applied %a@]"
| Wrong_name (eorp, ty_expected, kind, p, name, valid_names) ->
Location.error_of_printer ~loc (fun ppf () ->
let { ty; explanation } = ty_expected in
- reset_and_mark_loops ty;
if Path.is_constructor_typath p then begin
fprintf ppf
"@[The field %s is not part of the record \
| Invalid_format msg ->
Location.errorf ~loc "%s" msg
| Undefined_method (ty, me, valid_methods) ->
- reset_and_mark_loops ty;
Location.error_of_printer ~loc (fun ppf () ->
fprintf ppf
"@[<v>@[This expression has type@;<1 2>%a@]@,\
fprintf ppf "Unbound instance variable %s" var;
spellcheck ppf var valid_vars;
) ()
- | Instance_variable_not_mutable (b, v) ->
- if b then
- Location.errorf ~loc "The instance variable %s is not mutable" v
- else
- Location.errorf ~loc "The value %s is not an instance variable" v
+ | Instance_variable_not_mutable v ->
+ Location.errorf ~loc "The instance variable %s is not mutable" v
| Not_subtype(tr1, tr2) ->
Location.error_of_printer ~loc (fun ppf () ->
report_subtyping_error ppf env tr1 "is not a subtype of" tr2
"of the form: `(foo : ty1 :> ty2)'."
) ()
| Too_many_arguments (in_function, ty, explanation) ->
- reset_and_mark_loops ty;
if in_function then begin
Location.errorf ~loc
"This function expects too many arguments,@ \
| Nolabel -> "but its first argument is not labelled"
| l -> sprintf "but its first argument is labelled %s"
(prefixed_label_name l) in
- reset_and_mark_loops ty;
Location.errorf ~loc
"@[<v>@[<2>This function should have type@ %a%t@]@,%s@]"
type_expr ty
(report_type_expected_explanation_opt explanation)
(label_mark l)
| Scoping_let_module(id, ty) ->
- reset_and_mark_loops ty;
Location.errorf ~loc
"This `let module' expression has type@ %a@ \
In this type, the locally bound module name %s escapes its scope"
type_expr ty id
- | Masked_instance_variable lid ->
- Location.errorf ~loc
- "The instance variable %a@ \
- cannot be accessed from the definition of another instance variable"
- longident lid
| Private_type ty ->
Location.errorf ~loc "Cannot create values of the private type %a"
type_expr ty
Env.t -> Parsetree.expression ->
type_expr -> type_expr -> Typedtree.expression
-val option_some: Typedtree.expression -> Typedtree.expression
-val option_none: type_expr -> Location.t -> Typedtree.expression
+val option_some: Env.t -> Typedtree.expression -> Typedtree.expression
+val option_none: Env.t -> type_expr -> Location.t -> Typedtree.expression
val extract_option_type: Env.t -> type_expr -> type_expr
-val iter_pattern: (Typedtree.pattern -> unit) -> Typedtree.pattern -> unit
val generalizable: int -> type_expr -> bool
val reset_delayed_checks: unit -> unit
val force_delayed_checks: unit -> unit
| Private_label of Longident.t * type_expr
| Private_constructor of constructor_description * type_expr
| Unbound_instance_variable of string * string list
- | Instance_variable_not_mutable of bool * string
+ | Instance_variable_not_mutable of string
| Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t
| Outside_class
| Value_multiply_overridden of string
| Too_many_arguments of bool * type_expr * type_forcing_context option
| Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
| Scoping_let_module of string * type_expr
- | Masked_instance_variable of Longident.t
| Not_a_variant_type of Longident.t
| Incoherent_label_order
| Less_general of string * Ctype.Unification_trace.t
type_expansion_scope = Btype.lowest_level;
type_loc = sdecl.ptype_loc;
type_attributes = sdecl.ptype_attributes;
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
in
with Ctype.Unify trace ->
raise (Error(loc, Type_clash (env, trace)))
-let get_unboxed_type_representation =
- Typedecl_unboxed.get_unboxed_type_representation
+let get_unboxed_type_representation env ty =
+ match Typedecl_unboxed.get_unboxed_type_representation env ty with
+ | Typedecl_unboxed.This x -> Some x
+ | _ -> None
(* Determine if a type's values are represented by floats at run-time. *)
let is_float env ty =
match tm.desc with
Tvariant row ->
let row = Btype.row_repr row in
- tm.desc <- Tvariant {row with row_fixed = true};
+ tm.desc <- Tvariant {row with row_fixed = Some Fixed_private};
if Btype.static_row row then Btype.newgenty Tnil
else row.row_more
| Tobject (ty, _) ->
type_expansion_scope = Btype.lowest_level;
type_loc = sdecl.ptype_loc;
type_attributes = sdecl.ptype_attributes;
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_status;
} in
Ctype.end_def ();
(* Add abstract row *)
if is_fixed_type sdecl then begin
- let p =
- try Env.lookup_type (Longident.Lident(Ident.name id ^ "#row")) env
- with Not_found -> assert false in
+ let p, _ =
+ try Env.find_type_by_name
+ (Longident.Lident(Ident.name id ^ "#row")) env
+ with Not_found -> assert false
+ in
set_fixed_row env sdecl.ptype_loc p decl
end;
(* Check for cyclic abbreviations *)
in
match ty.desc with
| Tconstr(p, _, _) when arg_exn <> None || to_check p ->
- if to_check p then may raise arg_exn
+ if to_check p then Option.iter raise arg_exn
else Btype.iter_type_expr (check ty0 TypeSet.empty) ty;
begin try
let ty' = Ctype.try_expand_once_opt env ty in
let ty0 = if TypeSet.is_empty parents then ty else ty0 in
check ty0 (TypeSet.add ty parents) ty'
with
- Ctype.Cannot_expand -> may raise arg_exn
+ Ctype.Cannot_expand -> Option.iter raise arg_exn
end
- | _ -> may raise arg_exn
+ | _ -> Option.iter raise arg_exn
in
let snap = Btype.snapshot () in
try Ctype.wrap_trace_gadt_instances env (check ty TypeSet.empty) ty
Btype.iter_type_expr (check_regular cpath args prev_exp) ty
end in
- Misc.may
+ Option.iter
(fun body ->
let (args, body) =
Ctype.instance_parameterized_type
let sdecl_list =
List.map
(fun sdecl ->
- let ptype_name =
- mkloc (sdecl.ptype_name.txt ^"#row") sdecl.ptype_name.loc in
+ let ptype_name =
+ let loc = { sdecl.ptype_name.loc with Location.loc_ghost = true } in
+ mkloc (sdecl.ptype_name.txt ^"#row") loc
+ in
+ let ptype_kind = Ptype_abstract in
+ let ptype_manifest = None in
+ let ptype_loc = { sdecl.ptype_loc with Location.loc_ghost = true } in
{sdecl with
- ptype_name; ptype_kind = Ptype_abstract; ptype_manifest = None})
+ ptype_name; ptype_kind; ptype_manifest; ptype_loc })
fixed_types
@ sdecl_list
in
in
args, ret_type, Text_decl(targs, tret_type)
| Pext_rebind lid ->
- let cdescr = Typetexp.find_constructor env lid.loc lid.txt in
- let usage =
- if cdescr.cstr_private = Private || priv = Public
- then Env.Positive else Env.Privatize
- in
- Env.mark_constructor usage env (Longident.last lid.txt) cdescr;
+ let usage = if priv = Public then Env.Positive else Env.Privatize in
+ let cdescr = Env.lookup_constructor ~loc:lid.loc usage lid.txt env in
let (args, cstr_res) = Ctype.instance_constructor cdescr in
let res, ret_type =
if cdescr.cstr_generalized then
let transl_type_extension extend env loc styext =
reset_type_variables();
Ctype.begin_def();
- let (type_path, type_decl) =
+ let type_path, type_decl =
let lid = styext.ptyext_path in
- Typetexp.find_type env lid.loc lid.txt
+ Env.lookup_type ~loc:lid.loc lid.txt env
in
begin
match type_decl.type_kind with
List.iter
(fun ext ->
Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
- may Ctype.generalize ext.ext_type.ext_ret_type)
+ Option.iter Ctype.generalize ext.ext_type.ext_ret_type)
constructors;
(* Check that all type variables are closed *)
List.iter
Ctype.end_def();
(* Generalize types *)
Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
- may Ctype.generalize ext.ext_type.ext_ret_type;
+ Option.iter Ctype.generalize ext.ext_type.ext_ret_type;
(* Check that all type variables are closed *)
begin match Ctype.closed_extension_constructor ext.ext_type with
Some ty ->
type_expansion_scope = Btype.lowest_level;
type_loc = sdecl.ptype_loc;
type_attributes = sdecl.ptype_attributes;
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed;
}
in
type_expansion_scope = Btype.lowest_level;
type_loc = Location.none;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
} in
Ctype.end_def();
Printtyp.reset_and_mark_loops_list [typ ti; ty0];
fprintf ppf
".@.@[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
- kwd pr ti Printtyp.type_expr tv
+ kwd pr ti Printtyp.marked_type_expr tv
with Not_found -> ()
let explain_unbound ppf tv tl typ kwd lab =
explain_unbound_gen ppf tv tl typ kwd
- (fun ppf ti -> fprintf ppf "%s%a" (lab ti) Printtyp.type_expr (typ ti))
+ (fun ppf ti ->
+ fprintf ppf "%s%a" (lab ti) Printtyp.marked_type_expr (typ ti)
+ )
let explain_unbound_single ppf tv ty =
let trivial ty =
| Recursive_abbrev s ->
fprintf ppf "The type abbreviation %s is cyclic" s
| Cycle_in_def (s, ty) ->
- Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[<v>The definition of %s contains a cycle:@ %a@]"
s Printtyp.type_expr ty
| Definition_mismatch (ty, None) ->
- Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]@]"
"This variant or record definition" "does not match that of type"
Printtyp.type_expr ty
| Definition_mismatch (ty, Some err) ->
- Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
"This variant or record definition" "does not match that of type"
Printtyp.type_expr ty
| Rebind_wrong_type (lid, env, trace) ->
Printtyp.report_unification_error ppf env trace
(function ppf ->
- fprintf ppf "The constructor %a@ has type"
- Printtyp.longident lid)
+ fprintf ppf "The constructor %a@ has type"
+ Printtyp.longident lid)
(function ppf ->
fprintf ppf "but was expected to be of type")
| Rebind_mismatch (lid, p, p') ->
| 3 when not teen -> "rd"
| _ -> "th"
in
- (* FIXME: this test below is horrible, use a proper variant *)
- if n = -1 then
- fprintf ppf "@[%s@ %s@ It"
- "In this definition, a type variable has a variance that"
- "is not reflected by its occurrence in type parameters."
- else if n = -2 then
- fprintf ppf "@[%s@ %s@]"
- "In this definition, a type variable cannot be deduced"
- "from the type parameters."
- else if n = -3 then
- fprintf ppf "@[%s@ %s@ It"
- "In this definition, a type variable has a variance that"
- "cannot be deduced from the type parameters."
- else
- fprintf ppf "@[%s@ %s@ The %d%s type parameter"
- "In this definition, expected parameter"
- "variances are not satisfied."
- n (suffix n);
- if n <> -2 then
- fprintf ppf " was expected to be %s,@ but it is %s.@]"
- (variance v2) (variance v1)
+ (match n with
+ | Variance_not_reflected ->
+ fprintf ppf "@[%s@ %s@ It"
+ "In this definition, a type variable has a variance that"
+ "is not reflected by its occurrence in type parameters."
+ | No_variable ->
+ fprintf ppf "@[%s@ %s@]"
+ "In this definition, a type variable cannot be deduced"
+ "from the type parameters."
+ | Variance_not_deducible ->
+ fprintf ppf "@[%s@ %s@ It"
+ "In this definition, a type variable has a variance that"
+ "cannot be deduced from the type parameters."
+ | Variance_not_satisfied n ->
+ fprintf ppf "@[%s@ %s@ The %d%s type parameter"
+ "In this definition, expected parameter"
+ "variances are not satisfied."
+ n (suffix n));
+ (match n with
+ | No_variable -> ()
+ | _ ->
+ fprintf ppf " was expected to be %s,@ but it is %s.@]"
+ (variance v2) (variance v1))
| Unavailable_type_constructor p ->
fprintf ppf "The definition of type %a@ is unavailable" Printtyp.path p
| Bad_fixed_type r ->
fprintf ppf "Too many [@@unboxed]/[@@untagged] attributes"
| Cannot_unbox_or_untag_type Unboxed ->
fprintf ppf "@[Don't know how to unbox this type.@ \
- Only float, int32, int64 and nativeint can be unboxed.@]"
+ Only float, int32, int64 and nativeint can be unboxed.@]"
| Cannot_unbox_or_untag_type Untagged ->
fprintf ppf "@[Don't know how to untag this type.@ \
Only int can be untagged.@]"
| Deep_unbox_or_untag_attribute kind ->
fprintf ppf
"@[The attribute '%s' should be attached to@ \
- a direct argument or result of the primitive,@ \
- it should not occur deeply into its type.@]"
+ a direct argument or result of the primitive,@ \
+ it should not occur deeply into its type.@]"
(match kind with Unboxed -> "@unboxed" | Untagged -> "@untagged")
- | Immediacy Typedecl_immediacy.Bad_immediate_attribute ->
- fprintf ppf "@[%s@ %s@]"
- "Types marked with the immediate attribute must be"
- "non-pointer types like int or bool"
+ | Immediacy (Typedecl_immediacy.Bad_immediacy_attribute violation) ->
+ fprintf ppf "@[%a@]" Format.pp_print_text
+ (match violation with
+ | Type_immediacy.Violation.Not_always_immediate ->
+ "Types marked with the immediate attribute must be \
+ non-pointer types like int or bool."
+ | Type_immediacy.Violation.Not_always_immediate_on_64bits ->
+ "Types marked with the immediate64 attribute must be \
+ produced using the Stdlib.Sys.Immediate64.Make functor.")
| Bad_unboxed_attribute msg ->
fprintf ppf "@[This type cannot be unboxed because@ %s.@]" msg
| Wrong_unboxed_type_float ->
open Types
-type error = Bad_immediate_attribute
+type error = Bad_immediacy_attribute of Type_immediacy.Violation.t
exception Error of Location.t * error
-let marked_as_immediate decl =
- Builtin_attributes.immediate decl.type_attributes
-
let compute_decl env tdecl =
match (tdecl.type_kind, tdecl.type_manifest) with
| (Type_variant [{cd_args = Cstr_tuple [arg]; _}], _)
| (Type_record ([{ld_type = arg; _}], _), _)
when tdecl.type_unboxed.unboxed ->
begin match Typedecl_unboxed.get_unboxed_type_representation env arg with
- | Some argrepr -> not (Ctype.maybe_pointer_type env argrepr)
- | None -> false
+ | Typedecl_unboxed.Unavailable -> Type_immediacy.Unknown
+ | Typedecl_unboxed.This argrepr -> Ctype.immediacy env argrepr
+ | Typedecl_unboxed.Only_on_64_bits argrepr ->
+ match Ctype.immediacy env argrepr with
+ | Type_immediacy.Always -> Type_immediacy.Always_on_64bits
+ | Type_immediacy.Always_on_64bits | Type_immediacy.Unknown as x -> x
end
| (Type_variant (_ :: _ as cstrs), _) ->
- not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)
- | (Type_abstract, Some(typ)) ->
- not (Ctype.maybe_pointer_type env typ)
- | (Type_abstract, None) -> marked_as_immediate tdecl
- | _ -> false
+ if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)
+ then
+ Type_immediacy.Always
+ else
+ Type_immediacy.Unknown
+ | (Type_abstract, Some(typ)) -> Ctype.immediacy env typ
+ | (Type_abstract, None) -> Type_immediacy.of_attributes tdecl.type_attributes
+ | _ -> Type_immediacy.Unknown
-let property : (bool, unit) Typedecl_properties.property =
+let property : (Type_immediacy.t, unit) Typedecl_properties.property =
let open Typedecl_properties in
let eq = (=) in
let merge ~prop:_ ~new_prop = new_prop in
- let default _decl = false in
+ let default _decl = Type_immediacy.Unknown in
let compute env decl () = compute_decl env decl in
let update_decl decl immediacy = { decl with type_immediate = immediacy } in
let check _env _id decl () =
- if (marked_as_immediate decl) && (not decl.type_immediate) then
- raise (Error (decl.type_loc, Bad_immediate_attribute)) in
+ let written_by_user = Type_immediacy.of_attributes decl.type_attributes in
+ match Type_immediacy.coerce decl.type_immediate ~as_:written_by_user with
+ | Ok () -> ()
+ | Error violation ->
+ raise (Error (decl.type_loc,
+ Bad_immediacy_attribute violation))
+ in
{
eq;
merge;
(* *)
(**************************************************************************)
-type error = Bad_immediate_attribute
+type error = Bad_immediacy_attribute of Type_immediacy.Violation.t
exception Error of Location.t * error
-val compute_decl : Env.t -> Types.type_declaration -> bool
+val compute_decl : Env.t -> Types.type_declaration -> Type_immediacy.t
-val property : (bool, unit) Typedecl_properties.property
+val property : (Type_immediacy.t, unit) Typedecl_properties.property
val update_decls :
Env.t ->
open Types
+type t =
+ | Unavailable
+ | This of type_expr
+ | Only_on_64_bits of type_expr
+
(* We use the Ctype.expand_head_opt version of expand_head to get access
to the manifest type of private abbreviations. *)
let rec get_unboxed_type_representation env ty fuel =
- if fuel < 0 then None else
+ if fuel < 0 then Unavailable else
let ty = Ctype.repr (Ctype.expand_head_opt env ty) in
match ty.desc with
| Tconstr (p, args, _) ->
begin match Env.find_type p env with
- | exception Not_found -> Some ty
- | {type_immediate = true; _} -> Some Predef.type_int
- | {type_unboxed = {unboxed = false}} -> Some ty
+ | exception Not_found -> This ty
+ | {type_immediate = Always; _} ->
+ This Predef.type_int
+ | {type_immediate = Always_on_64bits; _} ->
+ Only_on_64_bits Predef.type_int
+ | {type_unboxed = {unboxed = false}} -> This ty
| {type_params; type_kind =
Type_record ([{ld_type = ty2; _}], _)
| Type_variant [{cd_args = Cstr_tuple [ty2]; _}]
let ty2 = match ty2.desc with Tpoly (t, _) -> t | _ -> ty2 in
get_unboxed_type_representation env
(Ctype.apply env type_params ty2 args) (fuel - 1)
- | {type_kind=Type_abstract} -> None
+ | {type_kind=Type_abstract} -> Unavailable
(* This case can occur when checking a recursive unboxed type
declaration. *)
| _ -> assert false (* only the above can be unboxed *)
end
- | _ -> Some ty
+ | _ -> This ty
let get_unboxed_type_representation env ty =
(* Do not give too much fuel: PR#7424 *)
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
open Types
+type t =
+ | Unavailable
+ | This of type_expr
+ | Only_on_64_bits of type_expr
+
(* for typeopt.ml *)
-val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option
+val get_unboxed_type_representation: Env.t -> type_expr -> t
type surface_variance = bool * bool * bool
+type variance_error =
+| Variance_not_satisfied of int
+| No_variable
+| Variance_not_reflected
+| Variance_not_deducible
+
type error =
-| Bad_variance of int * surface_variance * surface_variance
+| Bad_variance of variance_error * surface_variance * surface_variance
| Varying_anonymous
+
exception Error of Location.t * error
(* Compute variance *)
let var = get_variance ty tvl in
let (co,cn) = get_upper var and ij = mem Inj var in
if Btype.is_Tvar ty && (co && not c || cn && not n || not ij && i)
- then raise (Error(loc, Bad_variance (!pos, (co,cn,ij), (c,n,i)))))
+ then raise (Error(loc, Bad_variance
+ (Variance_not_satisfied !pos,
+ (co,cn,ij),
+ (c,n,i)))))
params required;
(* Check propagation from constrained parameters *)
let args = Btype.newgenty (Ttuple params) in
let (c1,n1) = get_upper v1 and (c2,n2,_,i2) = get_lower v2 in
if c1 && not c2 || n1 && not n2 then
if List.memq ty fvl then
- let code = if not i2 then -2 else if c2 || n2 then -1 else -3 in
+ let code = if not i2 then No_variable
+ else if c2 || n2 then Variance_not_reflected
+ else Variance_not_deducible in
raise (Error (loc, Bad_variance (code, (c1,n1,false), (c2,n2,false))))
else
Btype.iter_type_expr check ty
type req = surface_variance list
val property : (Variance.t list, req) property
+type variance_error =
+| Variance_not_satisfied of int
+| No_variable
+| Variance_not_reflected
+| Variance_not_deducible
+
type error =
-| Bad_variance of int * surface_variance * surface_variance
+| Bad_variance of variance_error * surface_variance * surface_variance
| Varying_anonymous
exception Error of Location.t * error
(* Abstract syntax tree after typing *)
-open Misc
open Asttypes
open Types
| Texp_setinstvar of Path.t * Path.t * string loc * expression
| Texp_override of Path.t * (Path.t * string loc * expression) list
| Texp_letmodule of
- Ident.t * string loc * Types.module_presence * module_expr * expression
+ Ident.t option * string option loc * Types.module_presence * module_expr *
+ expression
| Texp_letexception of extension_constructor * expression
| Texp_assert of expression
| Texp_lazy of expression
Tmodtype_implicit
| Tmodtype_explicit of module_type
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * string option loc * module_type
+
and module_expr_desc =
Tmod_ident of Path.t * Longident.t loc
| Tmod_structure of structure
- | Tmod_functor of Ident.t * string loc * module_type option * module_expr
+ | Tmod_functor of functor_parameter * module_expr
| Tmod_apply of module_expr * module_expr * module_coercion
| Tmod_constraint of
module_expr * Types.module_type * module_type_constraint * module_coercion
and module_binding =
{
- mb_id: Ident.t;
- mb_name: string loc;
+ mb_id: Ident.t option;
+ mb_name: string option loc;
mb_presence: module_presence;
mb_expr: module_expr;
mb_attributes: attribute list;
and module_type_desc =
Tmty_ident of Path.t * Longident.t loc
| Tmty_signature of signature
- | Tmty_functor of Ident.t * string loc * module_type option * module_type
+ | Tmty_functor of functor_parameter * module_type
| Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
| Tmty_typeof of module_expr
| Tmty_alias of Path.t * Longident.t loc
and module_declaration =
{
- md_id: Ident.t;
- md_name: string loc;
+ md_id: Ident.t option;
+ md_name: string option loc;
md_presence: module_presence;
md_type: module_type;
md_attributes: attribute list;
(* Auxiliary functions over the a.s.t. *)
-let iter_pattern_desc f = function
+let shallow_iter_pattern_desc f = function
| Tpat_alias(p, _, _) -> f p
| Tpat_tuple patl -> List.iter f patl
| Tpat_construct(_, _, patl) -> List.iter f patl
- | Tpat_variant(_, pat, _) -> may f pat
+ | Tpat_variant(_, pat, _) -> Option.iter f pat
| Tpat_record (lbl_pat_list, _) ->
List.iter (fun (_, _, pat) -> f pat) lbl_pat_list
| Tpat_array patl -> List.iter f patl
| Tpat_var _
| Tpat_constant _ -> ()
-let map_pattern_desc f d =
+let shallow_map_pattern_desc f d =
match d with
| Tpat_alias (p1, id, s) ->
Tpat_alias (f p1, id, s)
| Tpat_any
| Tpat_variant (_,None,_) -> d
-(* List the identifiers bound by a pattern or a let *)
+let rec iter_pattern f p =
+ f p;
+ shallow_iter_pattern_desc (iter_pattern f) p.pat_desc
-let idents = ref([]: (Ident.t * string loc * Types.type_expr) list)
+let exists_pattern f p =
+ let exception Found in
+ let raiser f x = if (f x) then raise Found else () in
+ match iter_pattern (raiser f) p with
+ | exception Found -> true
+ | () -> false
+
+(* List the identifiers bound by a pattern or a let *)
-let rec bound_idents pat =
+let rec iter_bound_idents f pat =
match pat.pat_desc with
- | Tpat_var (id,s) -> idents := (id,s,pat.pat_type) :: !idents
+ | Tpat_var (id,s) ->
+ f (id,s,pat.pat_type)
| Tpat_alias(p, id, s) ->
- bound_idents p; idents := (id,s,pat.pat_type) :: !idents
+ iter_bound_idents f p;
+ f (id,s,pat.pat_type)
| Tpat_or(p1, _, _) ->
- (* Invariant : both arguments binds the same variables *)
- bound_idents p1
- | d -> iter_pattern_desc bound_idents d
+ (* Invariant : both arguments bind the same variables *)
+ iter_bound_idents f p1
+ | d ->
+ shallow_iter_pattern_desc (iter_bound_idents f) d
-let pat_bound_idents_full pat =
- idents := [];
- bound_idents pat;
- let res = !idents in
- idents := [];
- res
-
-let pat_bound_idents pat =
- List.map (fun (id,_,_) -> id) (pat_bound_idents_full pat)
+let rev_pat_bound_idents_full pat =
+ let idents_full = ref [] in
+ let add id_full = idents_full := id_full :: !idents_full in
+ iter_bound_idents add pat;
+ !idents_full
-let rev_let_bound_idents_with_loc bindings =
- idents := [];
- List.iter (fun vb -> bound_idents vb.vb_pat) bindings;
- let res = !idents in idents := []; res
+let rev_only_idents idents_full =
+ List.rev_map (fun (id,_,_) -> id) idents_full
-let let_bound_idents_with_loc pat_expr_list =
- List.rev(rev_let_bound_idents_with_loc pat_expr_list)
+let pat_bound_idents_full pat =
+ List.rev (rev_pat_bound_idents_full pat)
+let pat_bound_idents pat =
+ rev_only_idents (rev_pat_bound_idents_full pat)
-let rev_let_bound_idents pat =
- List.map (fun (id,_,_) -> id) (rev_let_bound_idents_with_loc pat)
+let rev_let_bound_idents_full bindings =
+ let idents_full = ref [] in
+ let add id_full = idents_full := id_full :: !idents_full in
+ List.iter (fun vb -> iter_bound_idents add vb.vb_pat) bindings;
+ !idents_full
+let let_bound_idents_full bindings =
+ List.rev (rev_let_bound_idents_full bindings)
let let_bound_idents pat =
- List.map (fun (id,_,_) -> id) (let_bound_idents_with_loc pat)
+ rev_only_idents (rev_let_bound_idents_full pat)
let alpha_var env id = List.assoc id env
| Not_found -> new_p
end
| d ->
- {p with pat_desc = map_pattern_desc (alpha_pat env) d}
+ {p with pat_desc = shallow_map_pattern_desc (alpha_pat env) d}
let mkloc = Location.mkloc
let mknoloc = Location.mknoloc
| Texp_setinstvar of Path.t * Path.t * string loc * expression
| Texp_override of Path.t * (Path.t * string loc * expression) list
| Texp_letmodule of
- Ident.t * string loc * Types.module_presence * module_expr * expression
+ Ident.t option * string option loc * Types.module_presence * module_expr *
+ expression
| Texp_letexception of extension_constructor * expression
| Texp_assert of expression
| Texp_lazy of expression
| Tmodtype_explicit of module_type
(** The module type was in the source file. *)
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * string option loc * module_type
+
and module_expr_desc =
Tmod_ident of Path.t * Longident.t loc
| Tmod_structure of structure
- | Tmod_functor of Ident.t * string loc * module_type option * module_expr
+ | Tmod_functor of functor_parameter * module_expr
| Tmod_apply of module_expr * module_expr * module_coercion
| Tmod_constraint of
module_expr * Types.module_type * module_type_constraint * module_coercion
and module_binding =
{
- mb_id: Ident.t;
- mb_name: string loc;
+ mb_id: Ident.t option;
+ mb_name: string option loc;
mb_presence: module_presence;
mb_expr: module_expr;
mb_attributes: attributes;
and module_type_desc =
Tmty_ident of Path.t * Longident.t loc
| Tmty_signature of signature
- | Tmty_functor of Ident.t * string loc * module_type option * module_type
+ | Tmty_functor of functor_parameter * module_type
| Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
| Tmty_typeof of module_expr
| Tmty_alias of Path.t * Longident.t loc
and module_declaration =
{
- md_id: Ident.t;
- md_name: string loc;
+ md_id: Ident.t option;
+ md_name: string option loc;
md_presence: module_presence;
md_type: module_type;
md_attributes: attributes;
(* Auxiliary functions over the a.s.t. *)
-val iter_pattern_desc: (pattern -> unit) -> pattern_desc -> unit
-val map_pattern_desc: (pattern -> pattern) -> pattern_desc -> pattern_desc
+val shallow_iter_pattern_desc:
+ (pattern -> unit) -> pattern_desc -> unit
+val shallow_map_pattern_desc:
+ (pattern -> pattern) -> pattern_desc -> pattern_desc
-val let_bound_idents: value_binding list -> Ident.t list
-val rev_let_bound_idents: value_binding list -> Ident.t list
+val iter_pattern: (pattern -> unit) -> pattern -> unit
+val exists_pattern: (pattern -> bool) -> pattern -> bool
-val let_bound_idents_with_loc:
+val let_bound_idents: value_binding list -> Ident.t list
+val let_bound_idents_full:
value_binding list -> (Ident.t * string loc * type_expr) list
(** Alpha conversion of patterns *)
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
-let update_location loc = function
- Error (_, env, err) -> Error (loc, env, err)
- | err -> err
-let () = Typetexp.typemod_update_location := update_location
-
open Typedtree
let rec path_concat head p =
(* Compute the environment after opening a module *)
let type_open_ ?used_slot ?toplevel ovf env loc lid =
- let path = Typetexp.lookup_module ~load:true env lid.loc lid.txt in
+ let path = Env.lookup_module_path ~load:true ~loc:lid.loc lid.txt env in
match Env.open_signature ~loc ?used_slot ?toplevel ovf path env with
| Some env -> path, env
| None ->
env := env_before
);
Btype.it_module_type = (fun self -> function
- | Mty_functor (param, mty_arg, mty_body) ->
- may (self.Btype.it_module_type self) mty_arg;
+ | Mty_functor (param, mty_body) ->
let env_before = !env in
- env := lazy (Env.add_module ~arg:true param Mp_present
- (Btype.default_mty mty_arg) (Lazy.force env_before));
+ begin match param with
+ | Unit -> ()
+ | Named (param, mty_arg) ->
+ self.Btype.it_module_type self mty_arg;
+ match param with
+ | None -> ()
+ | Some id ->
+ env := lazy (Env.add_module ~arg:true id Mp_present
+ mty_arg (Lazy.force env_before))
+ end;
self.Btype.it_module_type self mty_body;
env := env_before;
| mty ->
let mty_arg = (Env.find_module arg env).md_type in
let mty_param =
match Env.scrape_alias env mty_functor with
- | Mty_functor (_, Some mty_param, _) -> mty_param
+ | Mty_functor (Named (_, mty_param), _) -> mty_param
| _ -> assert false (* could trigger due to MPR#7611 *)
in
Includemod.check_modtype_inclusion ~loc env mty_arg arg mty_param
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
type_attributes = [];
- type_immediate = false;
+ type_immediate = Unknown;
type_unboxed = unboxed_false_default_false;
}
and id_row = Ident.create_local (s^"#row") in
update_rec_next rs rem
| (Sig_module(id, pres, md, rs, priv) :: rem, [s], Pwith_module (_, lid'))
when Ident.name id = s ->
- let path, md' = Typetexp.find_module initial_env loc lid'.txt in
+ let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
let mty = md'.md_type in
let mty = Mtype.scrape_for_type_of ~remove_aliases env mty in
let md'' = { md' with md_type = mty } in
Sig_module(id, pres, newmd, rs, priv) :: rem
| (Sig_module(id, _, md, rs, _) :: rem, [s], Pwith_modsubst (_, lid'))
when Ident.name id = s ->
- let path, md' = Typetexp.find_module initial_env loc lid'.txt in
+ let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
let aliasable = not (Env.is_functor_arg path env) in
let newmd = Mtype.strengthen_decl ~aliasable env md' path in
ignore(Includemod.modtypes ~loc env newmd.md_type md.md_type);
in
match type_decl_is_alias sdecl with
| Some lid ->
- let replacement =
- try Env.lookup_type lid.txt initial_env
+ let replacement, _ =
+ try Env.find_type_by_name lid.txt initial_env
with Not_found -> assert false
in
fun s path -> Subst.add_type_path path replacement s
| None ->
- let body =
- match tdecl.typ_type.type_manifest with
- | None -> assert false
- | Some x -> x
- in
+ let body = Option.get tdecl.typ_type.type_manifest in
let params = tdecl.typ_type.type_params in
if params_are_constrained params
then raise(Error(loc, initial_env,
fun s path -> Subst.add_type_function path ~params ~body s
in
let sub = List.fold_left how_to_extend_subst Subst.identity !real_ids in
- (* This signature will not be used direcly, it will always be freshened
+ (* This signature will not be used directly, it will always be freshened
by the caller. So what we do with the scope doesn't really matter. But
making it local makes it unlikely that we will ever use the result of
this function unfreshened without issue. *)
let rec approx_modtype env smty =
match smty.pmty_desc with
Pmty_ident lid ->
- let (path, _info) = Typetexp.find_modtype env smty.pmty_loc lid.txt in
+ let (path, _info) =
+ Env.lookup_modtype ~use:false ~loc:smty.pmty_loc lid.txt env
+ in
Mty_ident path
| Pmty_alias lid ->
- let path = Typetexp.lookup_module env smty.pmty_loc lid.txt in
- Mty_alias path
+ let path =
+ Env.lookup_module_path ~use:false ~load:false
+ ~loc:smty.pmty_loc lid.txt env
+ in
+ Mty_alias(path)
| Pmty_signature ssg ->
Mty_signature(approx_sig env ssg)
- | Pmty_functor(param, sarg, sres) ->
- let arg = may_map (approx_modtype env) sarg in
- let rarg = Mtype.scrape_for_functor_arg env (Btype.default_mty arg) in
- let scope = Ctype.create_scope () in
- let (id, newenv) =
- Env.enter_module ~scope ~arg:true param.txt
- Mp_present rarg env
+ | Pmty_functor(param, sres) ->
+ let (param, newenv) =
+ match param with
+ | Unit -> Types.Unit, env
+ | Named (param, sarg) ->
+ let arg = approx_modtype env sarg in
+ match param.txt with
+ | None -> Types.Named (None, arg), env
+ | Some name ->
+ let rarg = Mtype.scrape_for_functor_arg env arg in
+ let scope = Ctype.create_scope () in
+ let (id, newenv) =
+ Env.enter_module ~scope ~arg:true name Mp_present rarg env
+ in
+ Types.Named (Some id, arg), newenv
in
let res = approx_modtype newenv sres in
- Mty_functor(id, arg, res)
+ Mty_functor(param, res)
| Pmty_with(sbody, constraints) ->
let body = approx_modtype env sbody in
List.iter
| Pwith_module (_, lid') ->
(* Lookup the module to make sure that it is not recursive.
(GPR#1626) *)
- ignore (Typetexp.find_module env lid'.loc lid'.txt)
+ ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env)
| Pwith_modsubst (_, lid') ->
- ignore (Typetexp.find_module env lid'.loc lid'.txt))
+ ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env))
constraints;
body
| Pmty_typeof smod ->
map_rec_type ~rec_flag
(fun rs (id, info) -> Sig_type(id, info, rs, Exported)) decls rem
| Psig_typesubst _ -> approx_sig env srem
+ | Psig_module { pmd_name = { txt = None; _ }; _ } ->
+ approx_sig env srem
| Psig_module pmd ->
let scope = Ctype.create_scope () in
- let id = Ident.create_scoped ~scope pmd.pmd_name.txt in
let md = approx_module_declaration env pmd in
let pres =
match md.Types.md_type with
| Mty_alias _ -> Mp_absent
| _ -> Mp_present
in
- let newenv = Env.enter_module_declaration id pres md env in
+ let id, newenv =
+ Env.enter_module_declaration ~scope (Option.get pmd.pmd_name.txt)
+ pres md env
+ in
Sig_module(id, pres, md, Trec_not, Exported) :: approx_sig newenv srem
| Psig_modsubst pms ->
let scope = Ctype.create_scope () in
- let id = Ident.create_scoped ~scope pms.pms_name.txt in
let _, md =
- Typetexp.find_module env pms.pms_manifest.loc pms.pms_manifest.txt
+ Env.lookup_module ~use:false ~loc:pms.pms_manifest.loc
+ pms.pms_manifest.txt env
in
let pres =
match md.Types.md_type with
| Mty_alias _ -> Mp_absent
| _ -> Mp_present
in
- let newenv = Env.enter_module_declaration id pres md env in
+ let _, newenv =
+ Env.enter_module_declaration ~scope pms.pms_name.txt pres md env
+ in
approx_sig newenv srem
| Psig_recmodule sdecls ->
let scope = Ctype.create_scope () in
let decls =
- List.map
+ List.filter_map
(fun pmd ->
- (Ident.create_scoped ~scope pmd.pmd_name.txt,
- approx_module_declaration env pmd)
+ Option.map (fun name ->
+ Ident.create_scoped ~scope name,
+ approx_module_declaration env pmd
+ ) pmd.pmd_name.txt
)
sdecls
in
and approx_modtype_info env sinfo =
{
- mtd_type = may_map (approx_modtype env) sinfo.pmtd_type;
+ mtd_type = Option.map (approx_modtype env) sinfo.pmtd_type;
mtd_attributes = sinfo.pmtd_attributes;
mtd_loc = sinfo.pmtd_loc;
}
(* Check and translate a module type expression *)
let transl_modtype_longident loc env lid =
- let (path, _info) = Typetexp.find_modtype env loc lid in
+ let (path, _info) = Env.lookup_modtype ~loc lid env in
path
let transl_module_alias loc env lid =
- Typetexp.lookup_module env loc lid
+ Env.lookup_module_path ~load:false ~loc lid env
let mkmty desc typ env loc attrs =
let mty = {
let sg = transl_signature env ssg in
mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
smty.pmty_attributes
- | Pmty_functor(param, sarg, sres) ->
- let arg = Misc.may_map (transl_modtype_functor_arg env) sarg in
- let ty_arg = Misc.may_map (fun m -> m.mty_type) arg in
- let scope = Ctype.create_scope () in
- let (id, newenv) =
- Env.enter_module ~scope ~arg:true
- param.txt Mp_present (Btype.default_mty ty_arg) env
+ | Pmty_functor(sarg_opt, sres) ->
+ let t_arg, ty_arg, newenv =
+ match sarg_opt with
+ | Unit -> Unit, Types.Unit, env
+ | Named (param, sarg) ->
+ let arg = transl_modtype_functor_arg env sarg in
+ let (id, newenv) =
+ match param.txt with
+ | None -> None, env
+ | Some name ->
+ let scope = Ctype.create_scope () in
+ let id, newenv =
+ let arg_md =
+ { md_type = arg.mty_type;
+ md_attributes = [];
+ md_loc = param.loc;
+ }
+ in
+ Env.enter_module_declaration ~scope ~arg:true name Mp_present
+ arg_md env
+ in
+ Some id, newenv
+ in
+ Named (id, param, arg), Types.Named (id, arg.mty_type), newenv
in
let res = transl_modtype newenv sres in
- mkmty (Tmty_functor (id, param, arg, res))
- (Mty_functor(id, ty_arg, res.mty_type)) env loc
+ mkmty (Tmty_functor (t_arg, res))
+ (Mty_functor(ty_arg, res.mty_type)) env loc
smty.pmty_attributes
| Pmty_with(sbody, constraints) ->
let body = transl_modtype env sbody in
final_env
| Psig_module pmd ->
let scope = Ctype.create_scope () in
- let id = Ident.create_scoped ~scope pmd.pmd_name.txt in
let tmty =
Builtin_attributes.warning_scope pmd.pmd_attributes
(fun () -> transl_modtype env pmd.pmd_type)
md_loc=pmd.pmd_loc;
}
in
- Signature_names.check_module names pmd.pmd_name.loc id;
- let newenv = Env.enter_module_declaration id pres md env in
+ let id, newenv =
+ match pmd.pmd_name.txt with
+ | None -> None, env
+ | Some name ->
+ let id, newenv =
+ Env.enter_module_declaration ~scope name pres md env
+ in
+ Signature_names.check_module names pmd.pmd_name.loc id;
+ Some id, newenv
+ in
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_module {md_id=id; md_name=pmd.pmd_name;
md_presence=pres; md_type=tmty;
md_loc=pmd.pmd_loc;
md_attributes=pmd.pmd_attributes})
env loc :: trem,
- Sig_module(id, pres, md, Trec_not, Exported) :: rem,
+ (match id with
+ | None -> rem
+ | Some id -> Sig_module(id, pres, md, Trec_not, Exported) :: rem),
final_env
| Psig_modsubst pms ->
let scope = Ctype.create_scope () in
- let id = Ident.create_scoped ~scope pms.pms_name.txt in
let path, md =
- Typetexp.find_module env pms.pms_manifest.loc pms.pms_manifest.txt
+ Env.lookup_module ~loc:pms.pms_manifest.loc
+ pms.pms_manifest.txt env
in
let aliasable = not (Env.is_functor_arg path env) in
let md =
| Mty_alias _ -> Mp_absent
| _ -> Mp_present
in
+ let id, newenv =
+ Env.enter_module_declaration ~scope pms.pms_name.txt pres md env
+ in
let info =
`Substituted_away (Subst.add_module id path Subst.identity)
in
Signature_names.check_module ~info names pms.pms_name.loc id;
- let newenv = Env.enter_module_declaration id pres md env in
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_modsubst {ms_id=id; ms_name=pms.pms_name;
ms_manifest=path; ms_txt=pms.pms_manifest;
rem,
final_env
| Psig_recmodule sdecls ->
- let (decls, newenv) =
+ let (tdecls, newenv) =
transl_recmodule_modtypes env sdecls in
+ let decls =
+ List.filter_map (fun md ->
+ match md.md_id with
+ | None -> None
+ | Some id -> Some (id, md)
+ ) tdecls
+ in
List.iter
- (fun md -> Signature_names.check_module names md.md_loc md.md_id)
+ (fun (id, md) -> Signature_names.check_module names md.md_loc id)
decls;
let (trem, rem, final_env) = transl_sig newenv srem in
- mksig (Tsig_recmodule decls) env loc :: trem,
- map_rec (fun rs md ->
+ mksig (Tsig_recmodule tdecls) env loc :: trem,
+ map_rec (fun rs (id, md) ->
let d = {Types.md_type = md.md_type.mty_type;
md_attributes = md.md_attributes;
md_loc = md.md_loc;
} in
- Sig_module(md.md_id, Mp_present, d, rs, Exported))
+ Sig_module(id, Mp_present, d, rs, Exported))
decls rem,
final_env
| Psig_modtype pmtd ->
and transl_modtype_decl_aux names env
{pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} =
- let tmty = Misc.may_map (transl_modtype env) pmtd_type in
+ let tmty =
+ Option.map (transl_modtype (Env.in_signature true env)) pmtd_type
+ in
let decl =
{
- Types.mtd_type=may_map (fun t -> t.mty_type) tmty;
+ Types.mtd_type=Option.map (fun t -> t.mty_type) tmty;
mtd_attributes=pmtd_attributes;
mtd_loc=pmtd_loc;
}
let make_env curr =
List.fold_left
(fun env (id, _, mty) ->
- Env.add_module ~arg:true id Mp_present mty env)
+ Option.fold ~none:env
+ ~some:(fun id -> Env.add_module ~arg:true id Mp_present mty env) id)
env curr in
let make_env2 curr =
List.fold_left
(fun env (id, _, mty) ->
- Env.add_module ~arg:true id Mp_present mty.mty_type env)
+ Option.fold ~none:env
+ ~some:(fun id ->
+ Env.add_module ~arg:true id Mp_present mty.mty_type env
+ ) id)
env curr in
let transition env_c curr =
List.map2
in
(id, id_loc, tmty))
sdecls curr in
- let map_mtys = List.map
+ let map_mtys =
+ List.filter_map
(fun (id, _, mty) ->
- (id, Types.{md_type = mty.mty_type;
- md_loc = mty.mty_loc;
- md_attributes = mty.mty_attributes})) in
+ Option.map (fun id ->
+ (id, Types.{md_type = mty.mty_type;
+ md_loc = mty.mty_loc;
+ md_attributes = mty.mty_attributes})
+ ) id)
+ in
let scope = Ctype.create_scope () in
let ids =
- List.map (fun x -> Ident.create_scoped ~scope x.pmd_name.txt) sdecls
+ List.map (fun x -> Option.map (Ident.create_scoped ~scope) x.pmd_name.txt)
+ sdecls
in
let approx_env =
- (*
- cf #5965
- We use a dummy module type in order to detect a reference to one
- of the module being defined during the call to approx_modtype.
- It will be detected in Env.lookup_module.
- *)
List.fold_left
- (fun env id ->
- let dummy =
- Mty_ident (Path.Pident (Ident.create_scoped ~scope "#recmod#"))
- in
- Env.add_module ~arg:true id Mp_present dummy env
- )
+ (fun env ->
+ Option.fold ~none:env ~some:(fun id -> (* cf #5965 *)
+ Env.enter_unbound_module (Ident.name id)
+ Mod_unbound_illegal_recursion env
+ ))
env ids
in
let init =
| Mty_signature sg ->
let env = Env.add_signature sg env in
List.for_all (closed_signature_item env) sg
- | Mty_functor(id, param, body) ->
+ | Mty_functor(arg_opt, body) ->
let env =
- Env.add_module ~arg:true id Mp_present (Btype.default_mty param) env
+ match arg_opt with
+ | Unit
+ | Named (None, _) -> env
+ | Named (Some id, param) ->
+ Env.add_module ~arg:true id Mp_present param env
in
closed_modtype env body
(* Helpers for typing recursive modules *)
let anchor_submodule name anchor =
- match anchor with None -> None | Some p -> Some(Pdot(p, name))
-let anchor_recmodule id =
- Some (Pident id)
+ match anchor, name with
+ | None, _
+ | _, None ->
+ None
+ | Some p, Some name ->
+ Some(Pdot(p, name))
+
+let anchor_recmodule = Option.map (fun id -> Pident id)
let enrich_type_decls anchor decls oldenv newenv =
match anchor with
oldenv decls
let enrich_module_type anchor name mty env =
- match anchor with
- None -> mty
- | Some p -> Mtype.enrich_modtype env (Pdot(p, name)) mty
+ match anchor, name with
+ | None, _
+ | _, None ->
+ mty
+ | Some p, Some name ->
+ Mtype.enrich_modtype env (Pdot(p, name)) mty
let check_recmodule_inclusion env bindings =
(* PR#4450, PR#4470: consider
the number of mutually recursive declarations. *)
let subst_and_strengthen env scope s id mty =
- Mtype.strengthen ~aliasable:false env (Subst.modtype (Rescope scope) s mty)
- (Subst.module_path s (Pident id)) in
+ let mty = Subst.modtype (Rescope scope) s mty in
+ match id with
+ | None -> mty
+ | Some id ->
+ Mtype.strengthen ~aliasable:false env mty
+ (Subst.module_path s (Pident id))
+ in
let rec check_incl first_time n env s =
let scope = Ctype.create_scope () in
(* Generate fresh names Y_i for the rec. bound module idents X_i *)
let bindings1 =
List.map
- (fun (id, name, _mty_decl, _modl, mty_actual, _attrs, _loc) ->
- (id, Ident.create_scoped ~scope name.txt, mty_actual))
+ (fun (id, _name, _mty_decl, _modl, mty_actual, _attrs, _loc) ->
+ let ids =
+ Option.map
+ (fun id -> (id, Ident.create_scoped ~scope (Ident.name id))) id
+ in
+ (ids, mty_actual))
bindings in
(* Enter the Y_i in the environment with their actual types substituted
by the input substitution s *)
let env' =
List.fold_left
- (fun env (id, id', mty_actual) ->
- let mty_actual' =
- if first_time
- then mty_actual
- else subst_and_strengthen env scope s id mty_actual in
- Env.add_module ~arg:false id' Mp_present mty_actual' env)
+ (fun env (ids, mty_actual) ->
+ match ids with
+ | None -> env
+ | Some (id, id') ->
+ let mty_actual' =
+ if first_time
+ then mty_actual
+ else subst_and_strengthen env scope s (Some id) mty_actual
+ in
+ Env.add_module ~arg:false id' Mp_present mty_actual' env)
env bindings1 in
(* Build the output substitution Y_i <- X_i *)
let s' =
List.fold_left
- (fun s (id, id', _mty_actual) ->
- Subst.add_module id (Pident id') s)
+ (fun s (ids, _mty_actual) ->
+ match ids with
+ | None -> s
+ | Some (id, id') -> Subst.add_module id (Pident id') s)
Subst.identity bindings1 in
(* Recurse with env' and s' *)
check_incl false (n-1) env' s'
end else begin
(* Base case: check inclusion of s(mty_actual) in s(mty_decl)
and insert coercion if needed *)
- let check_inclusion (id, id_loc, mty_decl, modl, mty_actual, attrs, loc) =
+ let check_inclusion (id, name, mty_decl, modl, mty_actual, attrs, loc) =
let mty_decl' = Subst.modtype (Rescope scope) s mty_decl.mty_type
and mty_actual' = subst_and_strengthen env scope s id mty_actual in
let coercion =
} in
{
mb_id = id;
- mb_name = id_loc;
+ mb_name = name;
mb_presence = Mp_present;
mb_expr = modl';
mb_attributes = attrs;
Mty_signature sg'
let modtype_of_package env loc p nl tl =
- try match (Env.find_modtype p env).mtd_type with
+ match (Env.find_modtype p env).mtd_type with
| Some mty when nl <> [] ->
package_constraints env loc mty
(List.combine (List.map Longident.flatten nl) tl)
| _ ->
if nl = [] then Mty_ident p
else raise(Error(loc, env, Signature_expected))
- with Not_found ->
- let error = Typetexp.Unbound_modtype (Ctype.lid_of_path p) in
- raise(Typetexp.Error(loc, env, error))
+ | exception Not_found -> assert false
let package_subtype env p1 nl1 tl1 p2 nl2 tl2 =
let mkmty p nl tl =
match smod.pmod_desc with
Pmod_ident lid ->
let path =
- Typetexp.lookup_module ~load:(not alias) env smod.pmod_loc lid.txt in
+ Env.lookup_module_path ~load:(not alias) ~loc:smod.pmod_loc lid.txt env
+ in
let md = { mod_desc = Tmod_ident (path, lid);
mod_type = Mty_alias path;
mod_env = env;
if List.length sg' = List.length sg then md else
wrap_constraint env false md (Mty_signature sg')
Tmodtype_implicit
- | Pmod_functor(name, smty, sbody) ->
- let mty = may_map (transl_modtype_functor_arg env) smty in
- let ty_arg = Misc.may_map (fun m -> m.mty_type) mty in
- let scope = Ctype.create_scope () in
- let (id, newenv), funct_body =
- match ty_arg with
- | None -> (Ident.create_scoped ~scope "*", env), false
- | Some mty ->
- Env.enter_module ~scope ~arg:true name.txt Mp_present mty env,
- true
+ | Pmod_functor(arg_opt, sbody) ->
+ let t_arg, ty_arg, newenv, funct_body =
+ match arg_opt with
+ | Unit -> Unit, Types.Unit, env, false
+ | Named (param, smty) ->
+ let mty = transl_modtype_functor_arg env smty in
+ let scope = Ctype.create_scope () in
+ let (id, newenv) =
+ match param.txt with
+ | None -> None, env
+ | Some name ->
+ let arg_md =
+ { md_type = mty.mty_type;
+ md_attributes = [];
+ md_loc = param.loc;
+ }
+ in
+ let id, newenv =
+ Env.enter_module_declaration ~scope ~arg:true name Mp_present
+ arg_md env
+ in
+ Some id, newenv
+ in
+ Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true
in
let body = type_module sttn funct_body None newenv sbody in
- rm { mod_desc = Tmod_functor(id, name, mty, body);
- mod_type = Mty_functor(id, ty_arg, body.mod_type);
+ rm { mod_desc = Tmod_functor(t_arg, body);
+ mod_type = Mty_functor(ty_arg, body.mod_type);
mod_env = env;
mod_attributes = smod.pmod_attributes;
mod_loc = smod.pmod_loc }
let funct =
type_module (sttn && path <> None) funct_body None env sfunct in
begin match Env.scrape_alias env funct.mod_type with
- Mty_functor(param, mty_param, mty_res) as mty_functor ->
- let generative, mty_param =
- (mty_param = None, Btype.default_mty mty_param) in
- if generative then begin
- if sarg.pmod_desc <> Pmod_structure [] then
- raise (Error (sfunct.pmod_loc, env, Apply_generative));
- if funct_body && Mtype.contains_type env funct.mod_type then
- raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
- end;
+ | Mty_functor (Unit, mty_res) ->
+ if sarg.pmod_desc <> Pmod_structure [] then
+ raise (Error (sfunct.pmod_loc, env, Apply_generative));
+ if funct_body && Mtype.contains_type env funct.mod_type then
+ raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
+ rm { mod_desc = Tmod_apply(funct, arg, Tcoerce_none);
+ mod_type = mty_res;
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc }
+ | Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
let coercion =
try
Includemod.modtypes ~loc:sarg.pmod_loc env arg.mod_type mty_param
raise(Error(sarg.pmod_loc, env, Not_included msg)) in
let mty_appl =
match path with
- Some path ->
+ | Some path ->
let scope = Ctype.create_scope () in
- Subst.modtype (Rescope scope)
- (Subst.add_module param path Subst.identity)
- mty_res
- | None ->
- if generative then mty_res else
- let env =
- Env.add_module ~arg:true param Mp_present arg.mod_type env
+ let subst =
+ match param with
+ | None -> Subst.identity
+ | Some p -> Subst.add_module p path Subst.identity
in
- check_well_formed_module env smod.pmod_loc
- "the signature of this functor application" mty_res;
- let nondep_mty =
- try Mtype.nondep_supertype env [param] mty_res
- with Ctype.Nondep_cannot_erase _ ->
- raise(Error(smod.pmod_loc, env,
- Cannot_eliminate_dependency mty_functor))
+ Subst.modtype (Rescope scope) subst mty_res
+ | None ->
+ let env, nondep_mty =
+ match param with
+ | None -> env, mty_res
+ | Some param ->
+ let env =
+ Env.add_module ~arg:true param Mp_present arg.mod_type
+ env
+ in
+ check_well_formed_module env smod.pmod_loc
+ "the signature of this functor application" mty_res;
+ try env, Mtype.nondep_supertype env [param] mty_res
+ with Ctype.Nondep_cannot_erase _ ->
+ raise(Error(smod.pmod_loc, env,
+ Cannot_eliminate_dependency mty_functor))
in
begin match
Includemod.modtypes ~loc:smod.pmod_loc env mty_res nondep_mty
List.map (fun (id, { Asttypes.loc; _ }, _typ)->
Signature_names.check_value names loc id;
Sig_value(id, Env.find_value (Pident id) newenv, Exported)
- ) (let_bound_idents_with_loc defs),
+ ) (let_bound_idents_full defs),
newenv
| Pstr_primitive sdesc ->
let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
| Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs;
pmb_loc;
} ->
+ let outer_scope = Ctype.get_current_level () in
let scope = Ctype.create_scope () in
- let id =
- Ident.create_scoped ~scope name.txt (* create early for PR#6752 *)
- in
- Signature_names.check_module names pmb_loc id;
let modl =
Builtin_attributes.warning_scope attrs
(fun () ->
}
in
(*prerr_endline (Ident.unique_toplevel_name id);*)
- Mtype.lower_nongen (scope - 1) md.md_type;
- let newenv = Env.enter_module_declaration id pres md env in
+ Mtype.lower_nongen outer_scope md.md_type;
+ let id, newenv, sg =
+ match name.txt with
+ | None -> None, env, []
+ | Some name ->
+ let id, e = Env.enter_module_declaration ~scope name pres md env in
+ Signature_names.check_module names pmb_loc id;
+ Some id, e,
+ [Sig_module(id, pres,
+ {md_type = modl.mod_type;
+ md_attributes = attrs;
+ md_loc = pmb_loc;
+ }, Trec_not, Exported)]
+ in
Tstr_module {mb_id=id; mb_name=name; mb_expr=modl;
mb_presence=pres; mb_attributes=attrs; mb_loc=pmb_loc; },
- [Sig_module(id, pres,
- {md_type = modl.mod_type;
- md_attributes = attrs;
- md_loc = pmb_loc;
- }, Trec_not, Exported)],
+ sg,
newenv
| Pstr_recmodule sbind ->
let sbind =
pmd_attributes=attrs; pmd_loc=loc}) sbind
) in
List.iter
- Signature_names.(fun md -> check_module names md.md_loc md.md_id)
+ (fun md ->
+ Option.iter Signature_names.(check_module names md.md_loc) md.md_id)
decls;
let bindings1 =
List.map2
)
in
let mty' =
- enrich_module_type anchor (Ident.name id) modl.mod_type newenv
+ enrich_module_type anchor name.txt modl.mod_type newenv
in
(id, name, mty, modl, mty', attrs, loc))
decls sbind in
let newenv = (* allow aliasing recursive modules from outside *)
List.fold_left
(fun env md ->
- let mdecl =
- {
- md_type = md.md_type.mty_type;
- md_attributes = md.md_attributes;
- md_loc = md.md_loc;
- }
- in
- Env.add_module_declaration ~check:true
- md.md_id Mp_present mdecl env
+ match md.md_id with
+ | None -> env
+ | Some id ->
+ let mdecl =
+ {
+ md_type = md.md_type.mty_type;
+ md_attributes = md.md_attributes;
+ md_loc = md.md_loc;
+ }
+ in
+ Env.add_module_declaration ~check:true
+ id Mp_present mdecl env
)
env decls
in
let bindings2 =
check_recmodule_inclusion newenv bindings1 in
+ let mbs =
+ List.filter_map (fun mb -> Option.map (fun id -> id, mb) mb.mb_id)
+ bindings2
+ in
Tstr_recmodule bindings2,
- map_rec (fun rs mb ->
- Sig_module(mb.mb_id, Mp_present, {
+ map_rec (fun rs (id, mb) ->
+ Sig_module(id, Mp_present, {
md_type=mb.mb_expr.mod_type;
md_attributes=mb.mb_attributes;
md_loc=mb.mb_loc;
}, rs, Exported))
- bindings2 [],
+ mbs [],
newenv
| Pstr_modtype pmtd ->
(* check that it is non-abstract *)
Mty_ident _
| Mty_alias _ -> ()
| Mty_signature sg -> normalize_signature env sg
- | Mty_functor(_id, _param, body) -> normalize_modtype env body
+ | Mty_functor(_param, body) -> normalize_modtype env body
and normalize_signature env = List.iter (normalize_signature_item env)
let tmty =
match smod.pmod_desc with
| Pmod_ident lid -> (* turn off strengthening in this case *)
- let path, md = Typetexp.find_module env smod.pmod_loc lid.txt in
+ let path, md = Env.lookup_module ~loc:smod.pmod_loc lid.txt env in
rm { mod_desc = Tmod_ident (path, lid);
mod_type = md.md_type;
mod_env = env;
(* For Typecore *)
+(* Graft a longident onto a path *)
+let rec extend_path path =
+ fun lid ->
+ match lid with
+ | Lident name -> Pdot(path, name)
+ | Ldot(m, name) -> Pdot(extend_path path m, name)
+ | Lapply _ -> assert false
+
+(* Lookup a type's longident within a signature *)
+let lookup_type_in_sig sg =
+ let types, modules =
+ List.fold_left
+ (fun acc item ->
+ match item with
+ | Sig_type(id, _, _, _) ->
+ let types, modules = acc in
+ let types = String.Map.add (Ident.name id) id types in
+ types, modules
+ | Sig_module(id, _, _, _, _) ->
+ let types, modules = acc in
+ let modules = String.Map.add (Ident.name id) id modules in
+ types, modules
+ | _ -> acc)
+ (String.Map.empty, String.Map.empty) sg
+ in
+ let rec module_path = function
+ | Lident name -> Pident (String.Map.find name modules)
+ | Ldot(m, name) -> Pdot(module_path m, name)
+ | Lapply _ -> assert false
+ in
+ fun lid ->
+ match lid with
+ | Lident name -> Pident (String.Map.find name types)
+ | Ldot(m, name) -> Pdot(module_path m, name)
+ | Lapply _ -> assert false
+
let type_package env m p nl =
(* Same as Pexp_letmodule *)
(* remember original level *)
let modl = type_module env m in
let scope = Ctype.create_scope () in
Typetexp.widen context;
- let (mp, env) =
- match modl.mod_desc with
- | Tmod_ident (mp,_) -> (mp, env)
- | Tmod_constraint ({mod_desc=Tmod_ident (mp,_)}, _, Tmodtype_implicit, _)
- -> (mp, env) (* PR#6982 *)
- | _ ->
- let (id, new_env) =
- Env.enter_module ~scope ~arg:true "%M" Mp_present modl.mod_type env
+ let nl', tl', env =
+ match nl with
+ | [] -> [], [], env
+ | nl ->
+ let type_path, env =
+ match modl.mod_desc with
+ | Tmod_ident (mp,_)
+ | Tmod_constraint
+ ({mod_desc=Tmod_ident (mp,_)}, _, Tmodtype_implicit, _) ->
+ (* We special case these because interactions between
+ strengthening of module types and packages can cause
+ spurious escape errors. See examples from PR#6982 in the
+ testsuite. This can be removed when such issues are
+ fixed. *)
+ extend_path mp, env
+ | _ ->
+ let sg = extract_sig_open env modl.mod_loc modl.mod_type in
+ let sg, env = Env.enter_signature ~scope sg env in
+ lookup_type_in_sig sg, env
in
- (Pident id, new_env)
- in
- let rec mkpath mp = function
- | Lident name -> Pdot(mp, name)
- | Ldot (m, name) -> Pdot(mkpath mp m, name)
- | _ -> assert false
+ let nl', tl' =
+ List.fold_right
+ (fun lid (nl, tl) ->
+ match type_path lid with
+ | exception Not_found -> (nl, tl)
+ | path -> begin
+ match Env.find_type path env with
+ | exception Not_found -> (nl, tl)
+ | decl ->
+ if decl.type_arity > 0 then begin
+ (nl, tl)
+ end else begin
+ let t = Btype.newgenty (Tconstr (path,[],ref Mnil)) in
+ (lid :: nl, t :: tl)
+ end
+ end)
+ nl ([], [])
+ in
+ nl', tl', env
in
- let tl' =
- List.map
- (fun name -> Btype.newgenty (Tconstr (mkpath mp name,[],ref Mnil)))
- (* beware of interactions with Printtyp and short-path:
- mp.name may have an arity > 0, cf. PR#7534 *)
- nl in
(* go back to original level *)
Ctype.end_def ();
- if nl = [] then
- (wrap_constraint env true modl (Mty_ident p) Tmodtype_implicit, [])
- else let mty = modtype_of_package env modl.mod_loc p nl tl' in
+ let mty =
+ if nl = [] then (Mty_ident p)
+ else modtype_of_package env modl.mod_loc p nl' tl'
+ in
List.iter2
(fun n ty ->
try Ctype.unify env ty (Ctype.newvar ())
with Ctype.Unify _ ->
- raise (Error(m.pmod_loc, env, Scoping_pack (n,ty))))
- nl tl';
- (wrap_constraint env true modl mty Tmodtype_implicit, tl')
+ raise (Error(modl.mod_loc, env, Scoping_pack (n,ty))))
+ nl' tl';
+ let modl = wrap_constraint env true modl mty Tmodtype_implicit in
+ (* Dropped exports should have produced an error above *)
+ assert (List.length nl = List.length tl');
+ modl, tl'
(* Fill in the forward declarations *)
row_more: type_expr;
row_bound: unit;
row_closed: bool;
- row_fixed: bool;
+ row_fixed: fixed_explanation option;
row_name: (Path.t * type_expr list) option }
-
+and fixed_explanation =
+ | Univar of type_expr | Fixed_private | Reified of Path.t | Rigid
and row_field =
Rpresent of type_expr option
| Reither of bool * type_expr list * bool * row_field option ref
(* Self *)
| Val_anc of (string * Ident.t) list * string
(* Ancestor *)
- | Val_unbound of value_unbound_reason (* Unbound variable *)
-
-and value_unbound_reason =
- | Val_unbound_instance_variable
- | Val_unbound_ghost_recursive
(* Variance *)
type_expansion_scope: int;
type_loc: Location.t;
type_attributes: Parsetree.attributes;
- type_immediate: bool;
+ type_immediate: Type_immediacy.t;
type_unboxed: unboxed_status;
}
type module_type =
Mty_ident of Path.t
| Mty_signature of signature
- | Mty_functor of Ident.t * module_type option * module_type
+ | Mty_functor of functor_parameter * module_type
| Mty_alias of Path.t
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * module_type
+
and module_presence =
| Mp_present
| Mp_absent
row_more: type_expr;
row_bound: unit; (* kept for compatibility *)
row_closed: bool;
- row_fixed: bool;
+ row_fixed: fixed_explanation option;
row_name: (Path.t * type_expr list) option }
-
+and fixed_explanation =
+ | Univar of type_expr (** The row type was bound to an univar *)
+ | Fixed_private (** The row type is private *)
+ | Reified of Path.t (** The row was reified *)
+ | Rigid (** The row type was made rigid during constraint verification *)
and row_field =
Rpresent of type_expr option
| Reither of bool * type_expr list * bool * row_field option ref
(* Self *)
| Val_anc of (string * Ident.t) list * string
(* Ancestor *)
- | Val_unbound of value_unbound_reason (* Unbound variable *)
-
-and value_unbound_reason =
- | Val_unbound_instance_variable
- | Val_unbound_ghost_recursive
(* Variance *)
type_expansion_scope: int;
type_loc: Location.t;
type_attributes: Parsetree.attributes;
- type_immediate: bool; (* true iff type should not be a pointer *)
+ type_immediate: Type_immediacy.t;
type_unboxed: unboxed_status;
}
type module_type =
Mty_ident of Path.t
| Mty_signature of signature
- | Mty_functor of Ident.t * module_type option * module_type
+ | Mty_functor of functor_parameter * module_type
| Mty_alias of Path.t
+and functor_parameter =
+ | Unit
+ | Named of Ident.t option * module_type
+
and module_presence =
| Mp_present
| Mp_absent
type error =
Unbound_type_variable of string
- | Unbound_type_constructor of Longident.t
- | Unbound_type_constructor_2 of Path.t
+ | Undefined_type_constructor of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
| Cannot_quantify of string * type_expr
| Multiple_constraints_on_type of Longident.t
| Method_mismatch of string * type_expr * type_expr
- | Unbound_value of Longident.t
- | Unbound_constructor of Longident.t
- | Unbound_label of Longident.t
- | Unbound_module of Longident.t
- | Unbound_class of Longident.t
- | Unbound_modtype of Longident.t
- | Unbound_cltype of Longident.t
- | Ill_typed_functor_application
- of Longident.t * Longident.t * Includemod.error list option
- | Illegal_reference_to_recursive_module
- | Wrong_use_of_module of Longident.t * [ `Structure_used_as_functor
- | `Abstract_used_as_functor
- | `Functor_used_as_structure
- | `Abstract_used_as_structure
- | `Generative_used_as_applicative
- ]
- | Cannot_scrape_alias of Longident.t * Path.t
| Opened_object of Path.t option
| Not_an_object of type_expr
- | Unbound_value_missing_rec of Longident.t * Location.t
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
type variable_context = int * type_expr TyVarMap.t
-(* To update locations from Typemod.check_well_founded_module. *)
-
-let typemod_update_location = ref (fun _ -> assert false)
-
-(* Narrowing unbound identifier errors. *)
-
-let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
- fun env loc lid make_error ->
- let check_module mlid =
- try ignore (Env.lookup_module ~load:true mlid env) with
- | Not_found ->
- narrow_unbound_lid_error env loc mlid (fun lid -> Unbound_module lid)
- | Env.Recmodule ->
- raise (Error (loc, env, Illegal_reference_to_recursive_module))
- in
- let error e = raise (Error (loc, env, e)) in
- begin match lid with
- | Longident.Lident _ -> ()
- | Longident.Ldot (mlid, _) ->
- check_module mlid;
- let md = Env.find_module (Env.lookup_module ~load:true mlid env) env in
- begin match Env.scrape_alias env md.md_type with
- | Mty_functor _ ->
- error (Wrong_use_of_module (mlid, `Functor_used_as_structure))
- | Mty_ident _ ->
- error (Wrong_use_of_module (mlid, `Abstract_used_as_structure))
- | Mty_alias p -> error (Cannot_scrape_alias(mlid, p))
- | Mty_signature _ -> ()
- end
- | Longident.Lapply (flid, mlid) ->
- check_module flid;
- let fmd = Env.find_module (Env.lookup_module ~load:true flid env) env in
- let mty_param =
- match Env.scrape_alias env fmd.md_type with
- | Mty_signature _ ->
- error (Wrong_use_of_module (flid, `Structure_used_as_functor))
- | Mty_ident _ ->
- error (Wrong_use_of_module (flid, `Abstract_used_as_functor))
- | Mty_alias p -> error (Cannot_scrape_alias(flid, p))
- | Mty_functor (_, None, _) ->
- error (Wrong_use_of_module (flid, `Generative_used_as_applicative))
- | Mty_functor (_, Some mty_param, _) -> mty_param
- in
- check_module mlid;
- let mpath = Env.lookup_module ~load:true mlid env in
- let mmd = Env.find_module mpath env in
- begin match Env.scrape_alias env mmd.md_type with
- | Mty_alias p -> error (Cannot_scrape_alias(mlid, p))
- | mty_arg ->
- let details =
- try Includemod.check_modtype_inclusion
- ~loc env mty_arg mpath mty_param;
- None (* should be impossible *)
- with Includemod.Error e -> Some e
- in
- error (Ill_typed_functor_application (flid, mlid, details))
- end
- end;
- error (make_error lid)
-
-let find_component (lookup : ?loc:_ -> ?mark:_ -> _) make_error env loc lid =
- try
- match lid with
- | Longident.Ldot (Longident.Lident "*predef*", s) ->
- lookup ~loc (Longident.Lident s) Env.initial_safe_string
- | _ ->
- lookup ~loc lid env
- with Not_found ->
- narrow_unbound_lid_error env loc lid make_error
- | Env.Recmodule ->
- raise (Error (loc, env, Illegal_reference_to_recursive_module))
- | err ->
- raise (!typemod_update_location loc err)
-
-let find_type env loc lid =
- let path =
- find_component Env.lookup_type (fun lid -> Unbound_type_constructor lid)
- env loc lid
- in
- let decl = Env.find_type path env in
- Builtin_attributes.check_alerts loc decl.type_attributes (Path.name path);
- (path, decl)
-
-let find_constructor =
- find_component Env.lookup_constructor (fun lid -> Unbound_constructor lid)
-let find_all_constructors =
- find_component Env.lookup_all_constructors
- (fun lid -> Unbound_constructor lid)
-let find_label =
- find_component Env.lookup_label (fun lid -> Unbound_label lid)
-let find_all_labels =
- find_component Env.lookup_all_labels (fun lid -> Unbound_label lid)
-
-let find_class env loc lid =
- let (path, decl) as r =
- find_component Env.lookup_class (fun lid -> Unbound_class lid) env loc lid
- in
- Builtin_attributes.check_alerts loc decl.cty_attributes (Path.name path);
- r
-
-let find_value env loc lid =
- Env.check_value_name (Longident.last lid) loc;
- let (path, decl) as r =
- find_component Env.lookup_value (fun lid -> Unbound_value lid) env loc lid
- in
- Builtin_attributes.check_alerts loc decl.val_attributes (Path.name path);
- r
-
-let lookup_module ?(load=false) env loc lid =
- find_component
- (fun ?loc ?mark lid env -> (Env.lookup_module ~load ?loc ?mark lid env))
- (fun lid -> Unbound_module lid) env loc lid
-
-let find_module env loc lid =
- let path = lookup_module ~load:true env loc lid in
- let decl = Env.find_module path env in
- (* No need to check for alerts here, this is done in Env. *)
- (path, decl)
-
-let find_modtype env loc lid =
- let (path, decl) as r =
- find_component Env.lookup_modtype (fun lid -> Unbound_modtype lid)
- env loc lid
- in
- Builtin_attributes.check_alerts loc decl.mtd_attributes (Path.name path);
- r
-
-let find_class_type env loc lid =
- let (path, decl) as r =
- find_component Env.lookup_cltype (fun lid -> Unbound_cltype lid)
- env loc lid
- in
- Builtin_attributes.check_alerts loc decl.clty_attributes (Path.name path);
- r
-
-let unbound_constructor_error env lid =
- narrow_unbound_lid_error env lid.loc lid.txt
- (fun lid -> Unbound_constructor lid)
-
-let unbound_label_error env lid =
- narrow_unbound_lid_error env lid.loc lid.txt
- (fun lid -> Unbound_label lid)
-
(* Support for first-class modules. *)
let transl_modtype_longident = ref (fun _ -> assert false)
let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in
ctyp (Ttyp_tuple ctys) ty
| Ptyp_constr(lid, stl) ->
- let (path, decl) = find_type env lid.loc lid.txt in
+ let (path, decl) = Env.lookup_type ~loc:lid.loc lid.txt env in
let stl =
match stl with
| [ {ptyp_desc=Ptyp_any} as t ] when decl.type_arity > 1 ->
| Ptyp_class(lid, stl) ->
let (path, decl, _is_variant) =
try
- let path = Env.lookup_type lid.txt env in
- let decl = Env.find_type path env in
+ let path, decl = Env.find_type_by_name lid.txt env in
let rec check decl =
match decl.type_manifest with
None -> raise Not_found
in check decl;
Location.deprecated styp.ptyp_loc
"old syntax for polymorphic variant type";
+ ignore(Env.lookup_type ~loc:lid.loc lid.txt env);
(path, decl,true)
with Not_found -> try
let lid2 =
| Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
| Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
in
- let path = Env.lookup_type lid2 env in
- let decl = Env.find_type path env in
+ let path, decl = Env.find_type_by_name lid2 env in
+ ignore(Env.lookup_cltype ~loc:lid.loc lid.txt env);
(path, decl, false)
with Not_found ->
- ignore (find_class env lid.loc lid.txt); assert false
+ ignore (Env.lookup_cltype ~loc:lid.loc lid.txt env); assert false
in
if List.length stl <> decl.type_arity then
raise(Error(styp.ptyp_loc, env,
in
let row = { row_closed = true; row_fields = fields;
row_bound = (); row_name = Some (path, ty_args);
- row_fixed = false; row_more = newvar () } in
+ row_fixed = None; row_more = newvar () } in
let static = Btype.static_row row in
let row =
if static then { row with row_more = newty Tnil }
let t = instance t in
let px = Btype.proxy t in
begin match px.desc with
- | Tvar None -> Btype.log_type px; px.desc <- Tvar (Some alias)
- | Tunivar None -> Btype.log_type px; px.desc <- Tunivar (Some alias)
+ | Tvar None -> Btype.set_type_desc px (Tvar (Some alias))
+ | Tunivar None -> Btype.set_type_desc px (Tunivar (Some alias))
| _ -> ()
end;
{ ty with ctyp_type = t }
let mkfield l f =
newty (Tvariant {row_fields=[l,f]; row_more=newvar();
row_bound=(); row_closed=true;
- row_fixed=false; row_name=None}) in
+ row_fixed=None; row_name=None}) in
let hfields = Hashtbl.create 17 in
let add_typed_field loc l f =
let h = Btype.hash_variant l in
let row = Btype.row_repr row in
row.row_fields
| {desc=Tvar _}, Some(p, _) ->
- raise(Error(sty.ptyp_loc, env, Unbound_type_constructor_2 p))
+ raise(Error(sty.ptyp_loc, env, Undefined_type_constructor p))
| _ ->
raise(Error(sty.ptyp_loc, env, Not_a_variant ty))
in
let row =
{ row_fields = List.rev fields; row_more = newvar ();
row_bound = (); row_closed = (closed = Closed);
- row_fixed = false; row_name = !name } in
+ row_fixed = None; row_name = !name } in
let static = Btype.static_row row in
let row =
if static then { row with row_more = newty Tnil }
OTinherit cty
end
| {desc=Tvar _}, Some p ->
- raise (Error (sty.ptyp_loc, env, Unbound_type_constructor_2 p))
+ raise (Error (sty.ptyp_loc, env, Undefined_type_constructor p))
| _ -> raise (Error (sty.ptyp_loc, env, Not_an_object t))
end in
{ of_desc; of_loc; of_attributes; }
match ty.desc with
| Tvariant row ->
let row = Btype.row_repr row in
- if Btype.is_Tunivar (Btype.row_more row) then
+ let more = Btype.row_more row in
+ if Btype.is_Tunivar more then
ty.desc <- Tvariant
- {row with row_fixed=true;
+ {row with row_fixed=Some(Univar more);
row_fields = List.map
(fun (s,f as p) -> match Btype.row_field_repr f with
Reither (c, tl, _m, r) -> s, Reither (c, tl, true, r)
open Format
open Printtyp
-let spellcheck ppf fold env lid =
- let choices ~path name =
- let env = fold (fun x xs -> x::xs) path env [] in
- Misc.spellcheck env name in
- match lid with
- | Longident.Lapply _ -> ()
- | Longident.Lident s ->
- Misc.did_you_mean ppf (fun () -> choices ~path:None s)
- | Longident.Ldot (r, s) ->
- Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s)
-
-let fold_descr fold get_name f = fold (fun descr acc -> f (get_name descr) acc)
-let fold_simple fold4 f = fold4 (fun name _path _descr acc -> f name acc)
-
-let fold_values f =
- (* We only use "real" values while spellchecking (as opposed to "ghost"
- values inserted in the environment to trigger the "missing rec" hint).
- This is needed in order to avoid dummy suggestions like:
- "unbound value x, did you mean x?" *)
- Env.fold_values
- (fun name _path descr acc ->
- match descr.val_kind with
- | Val_unbound _ -> acc
- | _ -> f name acc)
-let fold_types = fold_simple Env.fold_types
-let fold_modules = fold_simple Env.fold_modules
-let fold_constructors = fold_descr Env.fold_constructors (fun d -> d.cstr_name)
-let fold_labels = fold_descr Env.fold_labels (fun d -> d.lbl_name)
-let fold_classes = fold_simple Env.fold_classes
-let fold_modtypes = fold_simple Env.fold_modtypes
-let fold_cltypes = fold_simple Env.fold_cltypes
-
let report_error env ppf = function
| Unbound_type_variable name ->
let add_name name _ l = if name = "_" then l else ("'" ^ name) :: l in
fprintf ppf "The type variable %s is unbound in this type declaration.@ %a"
name
did_you_mean (fun () -> Misc.spellcheck names name )
- | Unbound_type_constructor lid ->
- fprintf ppf "Unbound type constructor %a" longident lid;
- spellcheck ppf fold_types env lid;
- | Unbound_type_constructor_2 p ->
+ | Undefined_type_constructor p ->
fprintf ppf "The type constructor@ %a@ is not yet completely defined"
path p
| Type_arity_mismatch(lid, expected, provided) ->
"which should be"
!Oprint.out_type (tree_of_typexp false ty'))
| Not_a_variant ty ->
- Printtyp.reset_and_mark_loops ty;
fprintf ppf
"@[The type %a@ does not expand to a polymorphic variant type@]"
Printtyp.type_expr ty;
fprintf ppf "Multiple constraints for type %a" longident s
| Method_mismatch (l, ty, ty') ->
wrap_printing_env ~error:true env (fun () ->
- Printtyp.reset_and_mark_loops_list [ty; ty'];
fprintf ppf "@[<hov>Method '%s' has type %a,@ which should be %a@]"
l Printtyp.type_expr ty Printtyp.type_expr ty')
- | Unbound_value lid ->
- fprintf ppf "Unbound value %a" longident lid;
- spellcheck ppf fold_values env lid;
- | Unbound_module lid ->
- fprintf ppf "Unbound module %a" longident lid;
- spellcheck ppf fold_modules env lid;
- | Unbound_constructor lid ->
- fprintf ppf "Unbound constructor %a" longident lid;
- spellcheck ppf fold_constructors env lid;
- | Unbound_label lid ->
- fprintf ppf "Unbound record field %a" longident lid;
- spellcheck ppf fold_labels env lid;
- | Unbound_class lid ->
- fprintf ppf "Unbound class %a" longident lid;
- spellcheck ppf fold_classes env lid;
- | Unbound_modtype lid ->
- fprintf ppf "Unbound module type %a" longident lid;
- spellcheck ppf fold_modtypes env lid;
- | Unbound_cltype lid ->
- fprintf ppf "Unbound class type %a" longident lid;
- spellcheck ppf fold_cltypes env lid;
- | Ill_typed_functor_application (flid, mlid, details) ->
- (match details with
- | None ->
- fprintf ppf "@[Ill-typed functor application %a(%a)@]"
- longident flid longident mlid
- | Some inclusion_error ->
- fprintf ppf "@[The type of %a does not match %a's parameter@\n%a@]"
- longident mlid longident flid Includemod.report_error inclusion_error)
- | Illegal_reference_to_recursive_module ->
- fprintf ppf "Illegal recursive module reference"
- | Wrong_use_of_module (lid, details) ->
- (match details with
- | `Structure_used_as_functor ->
- fprintf ppf "@[The module %a is a structure, it cannot be applied@]"
- longident lid
- | `Abstract_used_as_functor ->
- fprintf ppf "@[The module %a is abstract, it cannot be applied@]"
- longident lid
- | `Functor_used_as_structure ->
- fprintf ppf "@[The module %a is a functor, \
- it cannot have any components@]" longident lid
- | `Abstract_used_as_structure ->
- fprintf ppf "@[The module %a is abstract, \
- it cannot have any components@]" longident lid
- | `Generative_used_as_applicative ->
- fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
- applied@ in@ type@ expressions@]" longident lid)
- | Cannot_scrape_alias(lid, p) ->
- fprintf ppf
- "The module %a is an alias for module %a, which is missing"
- longident lid path p
| Opened_object nm ->
fprintf ppf
"Illegal open object type%a"
Some p -> fprintf ppf "@ %a" path p
| None -> fprintf ppf "") nm
| Not_an_object ty ->
- Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[The type %a@ is not an object type@]"
Printtyp.type_expr ty
- | Unbound_value_missing_rec (lid, loc) ->
- fprintf ppf
- "Unbound value %a" longident lid;
- spellcheck ppf fold_values env lid;
- let (_, line, _) = Location.get_pos_info loc.Location.loc_start in
- fprintf ppf
- "@.@[%s@ %s %i@]"
- "Hint: If this is a recursive definition,"
- "you should add the 'rec' keyword on line"
- line
let () =
Location.register_error_of_exn
type error =
Unbound_type_variable of string
- | Unbound_type_constructor of Longident.t
- | Unbound_type_constructor_2 of Path.t
+ | Undefined_type_constructor of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
| Cannot_quantify of string * type_expr
| Multiple_constraints_on_type of Longident.t
| Method_mismatch of string * type_expr * type_expr
- | Unbound_value of Longident.t
- | Unbound_constructor of Longident.t
- | Unbound_label of Longident.t
- | Unbound_module of Longident.t
- | Unbound_class of Longident.t
- | Unbound_modtype of Longident.t
- | Unbound_cltype of Longident.t
- | Ill_typed_functor_application
- of Longident.t * Longident.t * Includemod.error list option
- | Illegal_reference_to_recursive_module
- | Wrong_use_of_module of Longident.t * [ `Structure_used_as_functor
- | `Abstract_used_as_functor
- | `Functor_used_as_structure
- | `Abstract_used_as_structure
- | `Generative_used_as_applicative
- ]
- | Cannot_scrape_alias of Longident.t * Path.t
| Opened_object of Path.t option
| Not_an_object of type_expr
- | Unbound_value_missing_rec of Longident.t * Location.t
exception Error of Location.t * Env.t * error
Location.t -> Env.t -> Parsetree.package_type ->
(Longident.t Asttypes.loc * Parsetree.core_type) list *
Parsetree.module_type
-
-val find_type:
- Env.t -> Location.t -> Longident.t -> Path.t * type_declaration
-val find_constructor:
- Env.t -> Location.t -> Longident.t -> constructor_description
-val find_all_constructors:
- Env.t -> Location.t -> Longident.t ->
- (constructor_description * (unit -> unit)) list
-val find_label:
- Env.t -> Location.t -> Longident.t -> label_description
-val find_all_labels:
- Env.t -> Location.t -> Longident.t ->
- (label_description * (unit -> unit)) list
-val find_value:
- Env.t -> Location.t -> Longident.t -> Path.t * value_description
-val find_class:
- Env.t -> Location.t -> Longident.t -> Path.t * class_declaration
-val find_module:
- Env.t -> Location.t -> Longident.t -> Path.t * module_declaration
-val lookup_module:
- ?load:bool -> Env.t -> Location.t -> Longident.t -> Path.t
-val find_modtype:
- Env.t -> Location.t -> Longident.t -> Path.t * modtype_declaration
-val find_class_type:
- Env.t -> Location.t -> Longident.t -> Path.t * class_type_declaration
-
-val unbound_constructor_error: Env.t -> Longident.t Location.loc -> 'a
-val unbound_label_error: Env.t -> Longident.t Location.loc -> 'a
-
-(* To update location from typemod errors *)
-val typemod_update_location: (Location.t -> exn -> exn) ref
let sublen = String.length sub in
String.length str >= sublen && String.sub str 0 sublen = sub
-let map_opt f = function None -> None | Some e -> Some (f e)
-
let rec lident_of_path = function
| Path.Pident id -> Longident.Lident (Ident.name id)
| Path.Pdot (p, s) -> Longident.Ldot (lident_of_path p, s)
let fresh_name s env =
let rec aux i =
let name = s ^ Int.to_string i in
- try
- let _ = Env.lookup_value (Lident name) env in
- name
- with
- | Not_found -> aux (i+1)
+ if Env.bound_value name env then aux (i+1)
+ else name
in
aux 0
decl.typ_cstrs)
~kind:(sub.type_kind sub decl.typ_kind)
~priv:decl.typ_private
- ?manifest:(map_opt (sub.typ sub) decl.typ_manifest)
+ ?manifest:(Option.map (sub.typ sub) decl.typ_manifest)
(map_loc sub decl.typ_name)
let type_kind sub tk = match tk with
let attrs = sub.attributes sub cd.cd_attributes in
Type.constructor ~loc ~attrs
~args:(constructor_arguments sub cd.cd_args)
- ?res:(map_opt (sub.typ sub) cd.cd_res)
+ ?res:(Option.map (sub.typ sub) cd.cd_res)
(map_loc sub cd.cd_name)
let label_declaration sub ld =
(match ext.ext_kind with
| Text_decl (args, ret) ->
Pext_decl (constructor_arguments sub args,
- map_opt (sub.typ sub) ret)
+ Option.map (sub.typ sub) ret)
| Text_rebind (_p, lid) -> Pext_rebind (map_loc sub lid)
)
let attrs = sub.attributes sub pat.pat_attributes in
let desc =
match pat with
- { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } ->
- Ppat_unpack name
+ { pat_extra=[Tpat_unpack, loc, _attrs]; pat_desc = Tpat_any; _ } ->
+ Ppat_unpack { txt = None; loc }
+ | { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } ->
+ Ppat_unpack { name with txt = Some name.txt }
| { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } ->
Ppat_type (map_loc sub lid)
| { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } ->
begin
match (Ident.name id).[0] with
'A'..'Z' ->
- Ppat_unpack name
+ Ppat_unpack { name with txt = Some name.txt}
| _ ->
Ppat_var name
end
)
))
| Tpat_variant (label, pato, _) ->
- Ppat_variant (label, map_opt (sub.pat sub) pato)
+ Ppat_variant (label, Option.map (sub.pat sub) pato)
| Tpat_record (list, closed) ->
Ppat_record (List.map (fun (lid, _, pat) ->
map_loc sub lid, sub.pat sub pat) list, closed)
match extra with
Texp_coerce (cty1, cty2) ->
Pexp_coerce (sexp,
- map_opt (sub.typ sub) cty1,
+ Option.map (sub.typ sub) cty1,
sub.typ sub cty2)
| Texp_constraint cty ->
Pexp_constraint (sexp, sub.typ sub cty)
- | Texp_poly cto -> Pexp_poly (sexp, map_opt (sub.typ sub) cto)
+ | Texp_poly cto -> Pexp_poly (sexp, Option.map (sub.typ sub) cto)
| Texp_newtype s -> Pexp_newtype (mkloc s loc, sexp)
in
Exp.mk ~loc ~attrs desc
let case sub {c_lhs; c_guard; c_rhs} =
{
pc_lhs = sub.pat sub c_lhs;
- pc_guard = map_opt (sub.expr sub) c_guard;
+ pc_guard = Option.map (sub.expr sub) c_guard;
pc_rhs = sub.expr sub c_rhs;
}
(Exp.tuple ~loc (List.map (sub.expr sub) args))
))
| Texp_variant (label, expo) ->
- Pexp_variant (label, map_opt (sub.expr sub) expo)
+ Pexp_variant (label, Option.map (sub.expr sub) expo)
| Texp_record { fields; extended_expression; _ } ->
let list = Array.fold_left (fun l -> function
| _, Kept _ -> l
| _, Overridden (lid, exp) -> (lid, sub.expr sub exp) :: l)
[] fields
in
- Pexp_record (list, map_opt (sub.expr sub) extended_expression)
+ Pexp_record (list, Option.map (sub.expr sub) extended_expression)
| Texp_field (exp, lid, _label) ->
Pexp_field (sub.expr sub exp, map_loc sub lid)
| Texp_setfield (exp1, lid, _label, exp2) ->
| Texp_ifthenelse (exp1, exp2, expo) ->
Pexp_ifthenelse (sub.expr sub exp1,
sub.expr sub exp2,
- map_opt (sub.expr sub) expo)
+ Option.map (sub.expr sub) expo)
| Texp_sequence (exp1, exp2) ->
Pexp_sequence (sub.expr sub exp1, sub.expr sub exp2)
| Texp_while (exp1, exp2) ->
let loc = sub.location sub mtd.mtd_loc in
let attrs = sub.attributes sub mtd.mtd_attributes in
Mtd.mk ~loc ~attrs
- ?typ:(map_opt (sub.module_type sub) mtd.mtd_type)
+ ?typ:(Option.map (sub.module_type sub) mtd.mtd_type)
(map_loc sub mtd.mtd_name)
let signature sub sg =
let class_description sub = class_infos sub.class_type sub
let class_type_declaration sub = class_infos sub.class_type sub
+let functor_parameter sub : functor_parameter -> Parsetree.functor_parameter =
+ function
+ | Unit -> Unit
+ | Named (_, name, mtype) -> Named (name, sub.module_type sub mtype)
+
let module_type sub mty =
let loc = sub.location sub mty.mty_loc in
let attrs = sub.attributes sub mty.mty_attributes in
Tmty_ident (_path, lid) -> Pmty_ident (map_loc sub lid)
| Tmty_alias (_path, lid) -> Pmty_alias (map_loc sub lid)
| Tmty_signature sg -> Pmty_signature (sub.signature sub sg)
- | Tmty_functor (_id, name, mtype1, mtype2) ->
- Pmty_functor (name, map_opt (sub.module_type sub) mtype1,
- sub.module_type sub mtype2)
+ | Tmty_functor (arg, mtype2) ->
+ Pmty_functor (functor_parameter sub arg, sub.module_type sub mtype2)
| Tmty_with (mtype, list) ->
Pmty_with (sub.module_type sub mtype,
List.map (sub.with_constraint sub) list)
let desc = match mexpr.mod_desc with
Tmod_ident (_p, lid) -> Pmod_ident (map_loc sub lid)
| Tmod_structure st -> Pmod_structure (sub.structure sub st)
- | Tmod_functor (_id, name, mtype, mexpr) ->
- Pmod_functor (name, Misc.may_map (sub.module_type sub) mtype,
- sub.module_expr sub mexpr)
+ | Tmod_functor (arg, mexpr) ->
+ Pmod_functor
+ (functor_parameter sub arg, sub.module_expr sub mexpr)
| Tmod_apply (mexp1, mexp2, _) ->
Pmod_apply (sub.module_expr sub mexp1, sub.module_expr sub mexp2)
| Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
let desc = match cf.cf_desc with
Tcf_inherit (ovf, cl, super, _vals, _meths) ->
Pcf_inherit (ovf, sub.class_expr sub cl,
- map_opt (fun v -> mkloc v loc) super)
+ Option.map (fun v -> mkloc v loc) super)
| Tcf_constraint (cty, cty') ->
Pcf_constraint (sub.typ sub cty, sub.typ sub cty')
| Tcf_val (lab, mut, _, Tcfk_virtual cty, _) ->
FLEXDLL_DIR =
endif
+FLEXLINK_FLAGS ?=
+
+# Escape special characters in the argument string.
+# There are four characters that need escaping:
+# - backslash and ampersand, which are special in the replacement text
+# of sed's "s" command
+# - exclamation mark, which is the delimiter we use for sed's "s" command
+# - single quote, which interferes with shell quoting. We are inside
+# single quotes already, so the proper escape is '\''
+# (close single quotation, insert single quote character,
+# reopen single quotation).
+SED_ESCAPE=$(subst ','\'',$(subst !,\!,$(subst &,\&,$(subst \,\\,$1))))
+
+# Escape special characters in an OCaml string literal "..."
+# There are two: backslash and double quote.
+OCAML_ESCAPE=$(subst ",\",$(subst \,\\,$1))
+
# SUBST generates the sed substitution for the variable *named* in $1
-# SUBST_QUOTE does the same, adding double-quotes around non-empty strings
+SUBST=-e 's!%%$1%%!$(call SED_ESCAPE,$($1))!'
+
+# SUBST_STRING does the same, for a variable that occurs between "..."
+# in config.mlp. Thus, backslashes and double quotes must be escaped.
+SUBST_STRING=-e 's!%%$1%%!$(call SED_ESCAPE,$(call OCAML_ESCAPE,$($1)))!'
+
+# SUBST_QUOTE does the same, adding OCaml quotes around non-empty strings
# (see FLEXDLL_DIR which must empty if FLEXDLL_DIR is empty but an OCaml
# string otherwise)
-SUBST_ESCAPE=$(subst ",\\",$(subst \,\\,$(if $2,$2,$($1))))
-SUBST=-e 's|%%$1%%|$(call SUBST_ESCAPE,$1,$2)|'
-SUBST_QUOTE2=-e 's|%%$1%%|$(if $2,"$2")|'
-SUBST_QUOTE=$(call SUBST_QUOTE2,$1,$(call SUBST_ESCAPE,$1,$2))
+SUBST_QUOTE2=\
+ -e 's!%%$1%%!$(if $2,$(call SED_ESCAPE,"$(call OCAML_ESCAPE,$2)"))!'
+SUBST_QUOTE=$(call SUBST_QUOTE2,$1,$($1))
+
FLEXLINK_LDFLAGS=$(if $(OC_LDFLAGS), -link "$(OC_LDFLAGS)")
+
config.ml: config.mlp $(ROOTDIR)/Makefile.config Makefile
sed $(call SUBST,AFL_INSTRUMENT) \
$(call SUBST,ARCH) \
- $(call SUBST,ARCMD) \
- $(call SUBST,ASM) \
+ $(call SUBST_STRING,ARCMD) \
+ $(call SUBST_STRING,ASM) \
$(call SUBST,ASM_CFI_SUPPORTED) \
- $(call SUBST,BYTECCLIBS) \
- $(call SUBST,CC) \
- $(call SUBST,CCOMPTYPE) \
- $(call SUBST,OUTPUTOBJ) \
- $(call SUBST,EXT_ASM) \
- $(call SUBST,EXT_DLL) \
- $(call SUBST,EXE) \
- $(call SUBST,EXT_LIB) \
- $(call SUBST,EXT_OBJ) \
+ $(call SUBST_STRING,BYTECCLIBS) \
+ $(call SUBST_STRING,CC) \
+ $(call SUBST_STRING,CCOMPTYPE) \
+ $(call SUBST_STRING,OUTPUTOBJ) \
+ $(call SUBST_STRING,EXT_ASM) \
+ $(call SUBST_STRING,EXT_DLL) \
+ $(call SUBST_STRING,EXE) \
+ $(call SUBST_STRING,EXT_LIB) \
+ $(call SUBST_STRING,EXT_OBJ) \
$(call SUBST,FLAMBDA) \
$(call SUBST,WITH_FLAMBDA_INVARIANTS) \
- $(call SUBST,FLEXLINK_FLAGS) \
+ $(call SUBST_STRING,FLEXLINK_FLAGS) \
$(call SUBST_QUOTE,FLEXDLL_DIR) \
$(call SUBST,HOST) \
- $(call SUBST,LIBDIR) \
+ $(call SUBST_STRING,LIBDIR) \
$(call SUBST,LIBUNWIND_AVAILABLE) \
$(call SUBST,LIBUNWIND_LINK_FLAGS) \
- $(call SUBST,MKDLL) \
- $(call SUBST,MKEXE) \
- $(call SUBST,FLEXLINK_LDFLAGS) \
- $(call SUBST,MKMAINDLL) \
+ $(call SUBST_STRING,MKDLL) \
+ $(call SUBST_STRING,MKEXE) \
+ $(call SUBST_STRING,FLEXLINK_LDFLAGS) \
+ $(call SUBST_STRING,MKMAINDLL) \
$(call SUBST,MODEL) \
- $(call SUBST,NATIVECCLIBS) \
- $(call SUBST,OCAMLC_CFLAGS) \
- $(call SUBST,OCAMLC_CPPFLAGS) \
- $(call SUBST,OCAMLOPT_CFLAGS) \
- $(call SUBST,OCAMLOPT_CPPFLAGS) \
- $(call SUBST,PACKLD) \
+ $(call SUBST_STRING,NATIVECCLIBS) \
+ $(call SUBST_STRING,OCAMLC_CFLAGS) \
+ $(call SUBST_STRING,OCAMLC_CPPFLAGS) \
+ $(call SUBST_STRING,OCAMLOPT_CFLAGS) \
+ $(call SUBST_STRING,OCAMLOPT_CPPFLAGS) \
+ $(call SUBST_STRING,PACKLD) \
$(call SUBST,PROFINFO_WIDTH) \
- $(call SUBST,RANLIBCMD) \
+ $(call SUBST_STRING,RANLIBCMD) \
$(call SUBST,FORCE_SAFE_STRING) \
$(call SUBST,DEFAULT_SAFE_STRING) \
$(call SUBST,WINDOWS_UNICODE) \
$(call SUBST,WITH_SPACETIME) \
$(call SUBST,ENABLE_CALL_COUNTS) \
$(call SUBST,FLAT_FLOAT_ARRAY) \
+ $(call SUBST,FUNCTION_SECTIONS) \
$(call SUBST,CC_HAS_DEBUG_PREFIX_MAP) \
$(call SUBST,AS_HAS_DEBUG_PREFIX_MAP) \
$< > $@
+
+# Test for the substitution functions above
+
+ALLCHARS= \
+ !"\#\$\%&'()*+,-./ \
+ 0123456789:;<=>? \
+ @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_ \
+ `abcdefghijklmnopqrstuvwxyz{|}~
+
+TMPFILE=testdata.tmp
+TMPSCRIPT=ocamlscript.tmp
+
+test-subst:
+ $(file >$(TMPFILE),$(ALLCHARS))
+ echo '%%ALLCHARS%%' | sed $(call SUBST,ALLCHARS) | cmp $(TMPFILE) -
+ @rm $(TMPFILE)
+ @echo "Test passed"
+
+# This test assumes there is a working OCaml in the path
+
+test-subst-string:
+ $(file >$(TMPFILE),$(ALLCHARS))
+ echo 'print_string "%%ALLCHARS%%"; print_newline();;' \
+ | sed $(call SUBST_STRING,ALLCHARS) > $(TMPSCRIPT) && \
+ ocaml $(TMPSCRIPT) | cmp $(TMPFILE) -
+ @rm $(TMPFILE) $(TMPSCRIPT)
+ @echo "Test passed"
try
let first = input_line c in
if first <> Filename.basename name then
- print_string first;
+ print_endline first;
while true do
- print_string (input_line c)
+ print_endline (input_line c)
done
with _ ->
close_in c;
else cclib)
let call_linker mode output_name files extra =
- let cmd =
- if mode = Partial then
- let l_prefix =
- match Config.ccomp_type with
- | "msvc" -> "/libpath:"
- | _ -> "-L"
- in
- Printf.sprintf "%s%s %s %s %s"
- Config.native_pack_linker
- (Filename.quote output_name)
- (quote_prefixed l_prefix (Load_path.get_paths ()))
- (quote_files (remove_Wl files))
- extra
- else
- Printf.sprintf "%s -o %s %s %s %s %s %s"
- (match !Clflags.c_compiler, mode with
- | Some cc, _ -> cc
- | None, Exe -> Config.mkexe
- | None, Dll -> Config.mkdll
- | None, MainDll -> Config.mkmaindll
- | None, Partial -> assert false
- )
- (Filename.quote output_name)
- "" (*(Clflags.std_include_flag "-I")*)
- (quote_prefixed "-L" (Load_path.get_paths ()))
- (String.concat " " (List.rev !Clflags.all_ccopts))
- (quote_files files)
- extra
- in
- command cmd = 0
+ Profile.record_call "c-linker" (fun () ->
+ let cmd =
+ if mode = Partial then
+ let l_prefix =
+ match Config.ccomp_type with
+ | "msvc" -> "/libpath:"
+ | _ -> "-L"
+ in
+ Printf.sprintf "%s%s %s %s %s"
+ Config.native_pack_linker
+ (Filename.quote output_name)
+ (quote_prefixed l_prefix (Load_path.get_paths ()))
+ (quote_files (remove_Wl files))
+ extra
+ else
+ Printf.sprintf "%s -o %s %s %s %s %s %s"
+ (match !Clflags.c_compiler, mode with
+ | Some cc, _ -> cc
+ | None, Exe -> Config.mkexe
+ | None, Dll -> Config.mkdll
+ | None, MainDll -> Config.mkmaindll
+ | None, Partial -> assert false
+ )
+ (Filename.quote output_name)
+ "" (*(Clflags.std_include_flag "-I")*)
+ (quote_prefixed "-L" (Load_path.get_paths ()))
+ (String.concat " " (List.rev !Clflags.all_ccopts))
+ (quote_files files)
+ extra
+ in
+ command cmd = 0
+ )
and bytecode_compatible_32 = ref false (* -compat-32 *)
and output_c_object = ref false (* -output-obj *)
and output_complete_object = ref false (* -output-complete-obj *)
+and output_complete_executable = ref false (* -output-complete-exe *)
and all_ccopts = ref ([] : string list) (* -ccopt *)
and classic = ref false (* -nolabels *)
and nopervasives = ref false (* -nopervasives *)
let afl_instrument = ref Config.afl_instrument (* -afl-instrument *)
let afl_inst_ratio = ref 100 (* -afl-inst-ratio *)
+let function_sections = ref false (* -function-sections *)
+
let simplify_rounds = ref None (* -rounds *)
let default_simplify_rounds = ref 1 (* -rounds *)
let rounds () =
val bytecode_compatible_32 : bool ref
val output_c_object : bool ref
val output_complete_object : bool ref
+val output_complete_executable : bool ref
val all_ccopts : string list ref
val classic : bool ref
val nopervasives : bool ref
val classic_inlining : bool ref
val afl_instrument : bool ref
val afl_inst_ratio : int ref
+val function_sections : bool ref
val all_passes : string list ref
val dumped_pass : string -> bool
(** Whether the compiler and runtime automagically flatten float
arrays *)
+val function_sections : bool
+(** Whether the compiler was configured to generate
+ each function in a separate section *)
+
val windows_unicode: bool
(** Whether Windows Unicode runtime is enabled *)
let flat_float_array = %%FLAT_FLOAT_ARRAY%%
+let function_sections = %%FUNCTION_SECTIONS%%
let afl_instrument = %%AFL_INSTRUMENT%%
-let exec_magic_number = "Caml1999X026"
+let exec_magic_number = "Caml1999X027"
(* exec_magic_number is duplicated in runtime/caml/exec.h *)
-and cmi_magic_number = "Caml1999I026"
-and cmo_magic_number = "Caml1999O026"
-and cma_magic_number = "Caml1999A026"
+and cmi_magic_number = "Caml1999I027"
+and cmo_magic_number = "Caml1999O027"
+and cma_magic_number = "Caml1999A027"
and cmx_magic_number =
if flambda then
- "Caml1999y026"
+ "Caml1999y027"
else
- "Caml1999Y026"
+ "Caml1999Y027"
and cmxa_magic_number =
if flambda then
- "Caml1999z026"
+ "Caml1999z027"
else
- "Caml1999Z026"
-and ast_impl_magic_number = "Caml1999M026"
-and ast_intf_magic_number = "Caml1999N026"
-and cmxs_magic_number = "Caml1999D026"
-and cmt_magic_number = "Caml1999T026"
+ "Caml1999Z027"
+and ast_impl_magic_number = "Caml1999M027"
+and ast_intf_magic_number = "Caml1999N027"
+and cmxs_magic_number = "Caml1999D027"
+and cmt_magic_number = "Caml1999T027"
let interface_suffix = ref ".mli"
p_bool "safe_string" safe_string;
p_bool "default_safe_string" default_safe_string;
p_bool "flat_float_array" flat_float_array;
+ p_bool "function_sections" function_sections;
p_bool "afl_instrument" afl_instrument;
p_bool "windows_unicode" windows_unicode;
p_bool "supports_shared_libraries" supports_shared_libraries;
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+type t =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+let idx_of_field =
+ let curr = 0 in
+#define DOMAIN_STATE(type, name) \
+ let idx__##name = curr in \
+ let curr = curr + 1 in
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+ let _ = curr in
+ function
+#define DOMAIN_STATE(type, name) \
+ | Domain_##name -> idx__##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */
+/* Stephen Dolan, University of Cambridge */
+/* */
+/* Copyright 2019 Indian Institute of Technology, Madras */
+/* Copyright 2019 University of Cambridge */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+type t =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+val idx_of_field : t -> int
../Makefile.config
config.mlp)
(action (system "make -f %{mk} %{targets}")))
+
+(rule
+ (targets domainstate.ml)
+ (mode fallback)
+ (deps (:conf ../Makefile.config)
+ (:c domainstate.ml.c)
+ (:tbl ../runtime/caml/domain_state.tbl))
+ (action
+ (with-stdout-to %{targets}
+ (bash
+ "`grep '^CPP=' %{conf} | cut -d'=' -f2` -I ../runtime/caml %{c} %{tbl}"
+ ))))
+
+(rule
+ (targets domainstate.mli)
+ (mode fallback)
+ (deps (:conf ../Makefile.config)
+ (:c domainstate.mli.c)
+ (:tbl ../runtime/caml/domain_state.tbl))
+ (action
+ (with-stdout-to %{targets}
+ (bash
+ "`grep '^CPP=' %{conf} | cut -d'=' -f2` -I ../runtime/caml %{c} %{tbl}"
+ ))))
module Option = struct
type 'a t = 'a option
- let value_default f ~default a =
- match a with
- | None -> default
- | Some a -> f a
-
let print print_contents ppf t =
match t with
| None -> Format.pp_print_string ppf "None"
external compare : 'a -> 'a -> int = "%compare"
end
-let may = Option.iter
-let may_map = Option.map
-
(* File functions *)
let find_in_path path name =
| Raise e -> raise e
| Thunk e ->
match f e with
- | None ->
- x := Done None;
+ | (Error _ as err : _ result) ->
+ x := Done err;
log := Cons(x, e, !log);
- None
- | Some _ as y ->
- x := Done y;
- y
+ err
+ | Ok _ as res ->
+ x := Done res;
+ res
| exception e ->
x := Raise e;
raise e
element equal to [x] removed. *)
val split_last: 'a list -> 'a list * 'a
(* Return the last element and the other elements of the given list. *)
-val may: ('a -> unit) -> 'a option -> unit
-val may_map: ('a -> 'b) -> 'a option -> 'b option
type ref_and_value = R : 'a ref * 'a -> ref_and_value
module Option : sig
type 'a t = 'a option
- val value_default : ('a -> 'b) -> default:'b -> 'a t -> 'b
-
val print
: (Format.formatter -> 'a -> unit)
-> Format.formatter
val create_forced : 'b -> ('a, 'b) t
val create_failed : exn -> ('a, 'b) t
- (* [force_logged log f t] is equivalent to [force f t] but if [f] returns
- [None] then [t] is recorded in [log]. [backtrack log] will then reset all
- the recorded [t]s back to their original state. *)
+ (* [force_logged log f t] is equivalent to [force f t] but if [f]
+ returns [Error _] then [t] is recorded in [log]. [backtrack log]
+ will then reset all the recorded [t]s back to their original
+ state. *)
val log : unit -> log
- val force_logged : log -> ('a -> 'b option) -> ('a,'b option) t -> 'b option
+ val force_logged :
+ log -> ('a -> ('b, 'c) result) -> ('a,('b, 'c) result) t -> ('b, 'c) result
val backtrack : log -> unit
end
| Unsafe_without_parsing (* 64 *)
| Redefining_unit of string (* 65 *)
| Unused_open_bang of string (* 66 *)
+ | Unused_functor_parameter of string (* 67 *)
;;
(* If you remove a warning, leave a hole in the numbering. NEVER change
| Unsafe_without_parsing -> 64
| Redefining_unit _ -> 65
| Unused_open_bang _ -> 66
+ | Unused_functor_parameter _ -> 67
;;
-let last_warning_number = 66
+let last_warning_number = 67
;;
(* Must be the max number returned by the [number] function. *)
current := {(!current) with error; active}
(* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-32..42-44-45-48-50-60-66";;
+let defaults_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67";;
let defaults_warn_error = "-a+31";;
let () = parse_options false defaults_w;;
| Unused_module s -> "unused module " ^ s ^ "."
| Unboxable_type_in_prim_decl t ->
Printf.sprintf
- "This primitive declaration uses type %s, which is unannotated and\n\
- unboxable. The representation of such types may change in future\n\
- versions. You should annotate the declaration of %s with [@@boxed]\n\
- or [@@unboxed]." t t
+ "This primitive declaration uses type %s, whose representation\n\
+ may be either boxed or unboxed. Without an annotation to indicate\n\
+ which representation is intended, the boxed representation has been\n\
+ selected by default. This default choice may change in future\n\
+ versions of the compiler, breaking the primitive implementation.\n\
+ You should explicitly annotate the declaration of %s\n\
+ with [@@boxed] or [@@unboxed], so that its external interface\n\
+ remains stable in the future." t t
| Constraint_on_gadt ->
"Type constraints do not apply to GADT cases of variant types."
| Erroneous_printed_signature s ->
"This type declaration is defining a new '()' constructor\n\
which shadows the existing one.\n\
Hint: Did you mean 'type %s = unit'?" name
+ | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "."
;;
let nerrors = ref 0;;
| Unsafe_without_parsing (* 64 *)
| Redefining_unit of string (* 65 *)
| Unused_open_bang of string (* 66 *)
+ | Unused_functor_parameter of string (* 67 *)
;;
type alert = {kind:string; message:string; def:loc; use:loc}
ROOTDIR = ..
include $(ROOTDIR)/Makefile.config
+include $(ROOTDIR)/Makefile.common
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+ifeq "$(UNIX_OR_WIN32)" "win32"
+WSTR_OBJ = wstr
+else
+WSTR_OBJ =
+endif
+
ocamlyacc_SOURCES := $(addsuffix .c,\
- closure error lalr lr0 main mkpar output reader skeleton symtab verbose \
- warshall)
+ $(WSTR_OBJ) closure error lalr lr0 main mkpar output reader skeleton \
+ symtab verbose warshall)
ocamlyacc_OBJECTS := $(ocamlyacc_SOURCES:.c=.$(O))
all: ocamlyacc$(EXE)
-ifeq ($(TOOLCHAIN),cc)
-MKEXE_ANSI=$(MKEXE)
-endif
-
ocamlyacc$(EXE): $(ocamlyacc_OBJECTS)
- $(MKEXE_ANSI) -o $@ $^ $(EXTRALIBS)
+ $(MKEXE) -o $@ $^ $(EXTRALIBS)
version.h : $(ROOTDIR)/VERSION
echo "#define OCAML_VERSION \"`sed -e 1q $< | tr -d '\r'`\"" > $@
symtab.$(O): defs.h
verbose.$(O): defs.h
warshall.$(O): defs.h
-
-# The following rule is similar to make's default one, except that it
-# also works for .obj files.
-
-%.$(O): %.c
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
-#include "caml/s.h"
+#include <string.h>
+#define CAML_INTERNALS
+#include "caml/config.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+
+#define caml_stat_strdup strdup
/* machine-dependent definitions */
/* the following definitions are for the Tahoe */
/* defines for constructing filenames */
-#define CODE_SUFFIX ".code.c"
-#define DEFINES_SUFFIX ".tab.h"
-#define OUTPUT_SUFFIX ".ml"
-#define VERBOSE_SUFFIX ".output"
-#define INTERFACE_SUFFIX ".mli"
+#define OUTPUT_SUFFIX T(".ml")
+#define VERBOSE_SUFFIX T(".output")
+#define INTERFACE_SUFFIX T(".mli")
/* keyword codes */
/* global variables */
-extern char dflag;
extern char lflag;
extern char rflag;
extern char tflag;
extern char eflag;
extern char big_endian;
+/* myname should be UTF-8 encoded */
extern char *myname;
extern char *cptr;
extern char *line;
extern int lineno;
+/* virtual_input_file_name should be UTF-8 encoded */
extern char *virtual_input_file_name;
extern int outline;
-extern char *action_file_name;
-extern char *entry_file_name;
-extern char *code_file_name;
-extern char *defines_file_name;
-extern char *input_file_name;
-extern char *output_file_name;
-extern char *text_file_name;
-extern char *verbose_file_name;
-extern char *interface_file_name;
+extern char_os *action_file_name;
+extern char_os *entry_file_name;
+extern char_os *code_file_name;
+extern char_os *input_file_name;
+extern char_os *output_file_name;
+extern char_os *text_file_name;
+extern char_os *verbose_file_name;
+extern char_os *interface_file_name;
+
+/* UTF-8 versions of code_file_name and input_file_name */
+extern char *code_file_name_disp;
+extern char *input_file_name_disp;
extern FILE *action_file;
extern FILE *entry_file;
extern FILE *code_file;
-extern FILE *defines_file;
extern FILE *input_file;
extern FILE *output_file;
extern FILE *text_file;
extern int nvars;
extern int ntags;
-extern char line_format[];
+#define line_format "# %d \"%s\"\n"
extern int start_symbol;
extern char **symbol_name;
/* global functions */
-#ifdef __GNUC__
-/* Works only in GCC 2.5 and later */
-#define Noreturn __attribute ((noreturn))
-#else
-#define Noreturn
-#endif
-
extern char *allocate(unsigned int n);
extern bucket *lookup(char *name);
extern bucket *make_bucket(char *name);
extern void make_parser (void);
extern void no_grammar (void) Noreturn;
extern void no_space (void) Noreturn;
-extern void open_error (char *filename) Noreturn;
+extern void open_error (char_os *filename) Noreturn;
extern void output (void);
extern void prec_redeclared (void);
extern void polymorphic_entry_point(char *s) Noreturn;
#include "defs.h"
+/* String displayed if we can't malloc a buffer for the UTF-8 conversion */
+static char *unknown = "<unknown; out of memory>";
+
void fatal(char *msg)
{
fprintf(stderr, "%s: f - %s\n", myname, msg);
}
-void open_error(char *filename)
+void open_error(char_os *filename)
{
- fprintf(stderr, "%s: f - cannot open \"%s\"\n", myname, filename);
+ char *u8 = caml_stat_strdup_of_os(filename);
+ fprintf(stderr, "%s: f - cannot open \"%s\"\n", myname, (u8 ? u8 : unknown));
done(2);
}
#include "version.h"
-char dflag;
char lflag;
char rflag;
char tflag;
char sflag;
char big_endian;
-char *file_prefix = 0;
+char_os *file_prefix = 0;
char *myname = "yacc";
-char temp_form[] = "yacc.XXXXXXX";
+char_os temp_form[] = T("yacc.XXXXXXX");
#ifdef _WIN32
-char dirsep = '\\';
+wchar_t dirsep = L'\\';
+/* mingw provides an implementation of mkstemp, but it's ANSI only */
+#undef HAS_MKSTEMP
#else
char dirsep = '/';
#endif
char *virtual_input_file_name = NULL;
int outline;
-char *action_file_name;
-char *entry_file_name;
-char *code_file_name;
-char *interface_file_name;
-char *defines_file_name;
-char *input_file_name = "";
-char *output_file_name;
-char *text_file_name;
-char *verbose_file_name;
+char_os *action_file_name;
+char_os *entry_file_name;
+char_os *code_file_name;
+char *code_file_name_disp;
+char_os *interface_file_name;
+char_os *input_file_name = T("");
+char *input_file_name_disp;
+char_os *output_file_name;
+char_os *text_file_name;
+char_os *verbose_file_name;
#ifdef HAS_MKSTEMP
int action_fd = -1, entry_fd = -1, text_fd = -1;
/* with rules until the parser is written */
FILE *entry_file;
FILE *code_file; /* y.code.c (used when the -r option is specified) */
-FILE *defines_file; /* y.tab.h */
FILE *input_file; /* the input file */
FILE *output_file; /* y.tab.c */
FILE *text_file; /* a temp file, used to save text until all */
short **derives;
char *nullable;
-#if !defined(HAS_MKSTEMP)
-extern char *mktemp(char *);
-#endif
-
void done(int k)
{
if (text_fd != -1)
unlink(text_file_name);
#else
- if (action_file) { fclose(action_file); unlink(action_file_name); }
- if (entry_file) { fclose(entry_file); unlink(entry_file_name); }
- if (text_file) { fclose(text_file); unlink(text_file_name); }
+ if (action_file) { fclose(action_file); unlink_os(action_file_name); }
+ if (entry_file) { fclose(entry_file); unlink_os(entry_file_name); }
+ if (text_file) { fclose(text_file); unlink_os(text_file_name); }
#endif
if (output_file && k > 0) {
- fclose(output_file); unlink(output_file_name);
+ fclose(output_file); unlink_os(output_file_name);
}
if (interface_file && k > 0) {
- fclose(interface_file); unlink(interface_file_name);
+ fclose(interface_file); unlink_os(interface_file_name);
}
exit(k);
}
exit(1);
}
-void getargs(int argc, char **argv)
+void getargs(int argc, char_os **argv)
{
register int i;
- register char *s;
+ register char_os *s;
- if (argc > 0) myname = argv[0];
+ if (argc > 0) myname = caml_stat_strdup_of_os(argv[0]);
+ if (!myname) no_space();
for (i = 1; i < argc; ++i)
{
s = argv[i];
{
case '\0':
input_file = stdin;
- file_prefix = "stdin";
+ file_prefix = T("stdin");
if (i + 1 < argc) usage();
return;
case '-':
- if (!strcmp (argv[i], "--strict")){
+ if (!strcmp_os (argv[i], T("--strict"))){
eflag = 1;
goto end_of_option;
}
goto no_more_options;
case 'v':
- if (!strcmp (argv[i], "-version")){
+ if (!strcmp_os (argv[i], T("-version"))){
printf ("The OCaml parser generator, version "
OCAML_VERSION "\n");
exit (0);
- }else if (!strcmp (argv[i], "-vnum")){
+ }else if (!strcmp_os (argv[i], T("-vnum"))){
printf (OCAML_VERSION "\n");
exit (0);
}else{
no_more_options:;
if (i + 1 != argc) usage();
input_file_name = argv[i];
+ input_file_name_disp = caml_stat_strdup_of_os(input_file_name);
+ if (!input_file_name_disp) no_space();
if (file_prefix == 0) {
int len;
- len = strlen(argv[i]);
- file_prefix = malloc(len + 1);
+ len = strlen_os(argv[i]);
+ file_prefix = MALLOC((len + 1) * sizeof(char_os));
if (file_prefix == 0) no_space();
- strcpy(file_prefix, argv[i]);
+ strcpy_os(file_prefix, argv[i]);
while (len > 0) {
len--;
if (file_prefix[len] == '.') {
void create_file_names(void)
{
int i, len;
- char *tmpdir;
+ char_os *tmpdir;
#ifdef _WIN32
- tmpdir = getenv("TEMP");
- if (tmpdir == 0) tmpdir = ".";
+ tmpdir = _wgetenv(L"TEMP");
+ if (tmpdir == 0) tmpdir = L".";
#else
tmpdir = getenv("TMPDIR");
if (tmpdir == 0) tmpdir = "/tmp";
#endif
- len = strlen(tmpdir);
+ len = strlen_os(tmpdir);
i = len + sizeof(temp_form);
if (len && tmpdir[len-1] != dirsep)
++i;
- action_file_name = MALLOC(i);
+ action_file_name = MALLOC(i * sizeof(char_os));
if (action_file_name == 0) no_space();
- entry_file_name = MALLOC(i);
+ entry_file_name = MALLOC(i * sizeof(char_os));
if (entry_file_name == 0) no_space();
- text_file_name = MALLOC(i);
+ text_file_name = MALLOC(i * sizeof(char_os));
if (text_file_name == 0) no_space();
- strcpy(action_file_name, tmpdir);
- strcpy(entry_file_name, tmpdir);
- strcpy(text_file_name, tmpdir);
+ strcpy_os(action_file_name, tmpdir);
+ strcpy_os(entry_file_name, tmpdir);
+ strcpy_os(text_file_name, tmpdir);
if (len && tmpdir[len - 1] != dirsep)
{
++len;
}
- strcpy(action_file_name + len, temp_form);
- strcpy(entry_file_name + len, temp_form);
- strcpy(text_file_name + len, temp_form);
+ strcpy_os(action_file_name + len, temp_form);
+ strcpy_os(entry_file_name + len, temp_form);
+ strcpy_os(text_file_name + len, temp_form);
- action_file_name[len + 5] = 'a';
- entry_file_name[len + 5] = 'e';
- text_file_name[len + 5] = 't';
+ action_file_name[len + 5] = L'a';
+ entry_file_name[len + 5] = L'e';
+ text_file_name[len + 5] = L't';
#ifdef HAS_MKSTEMP
action_fd = mkstemp(action_file_name);
if (text_fd == -1)
open_error(text_file_name);
#else
- mktemp(action_file_name);
- mktemp(entry_file_name);
- mktemp(text_file_name);
+ mktemp_os(action_file_name);
+ mktemp_os(entry_file_name);
+ mktemp_os(text_file_name);
#endif
- len = strlen(file_prefix);
+ len = strlen_os(file_prefix);
- output_file_name = MALLOC(len + 7);
+ output_file_name = MALLOC((len + 7) * sizeof(char_os));
if (output_file_name == 0)
no_space();
- strcpy(output_file_name, file_prefix);
- strcpy(output_file_name + len, OUTPUT_SUFFIX);
+ strcpy_os(output_file_name, file_prefix);
+ strcpy_os(output_file_name + len, OUTPUT_SUFFIX);
code_file_name = output_file_name;
+ code_file_name_disp = caml_stat_strdup_of_os(code_file_name);
+ if (!code_file_name_disp) no_space();
if (vflag)
{
- verbose_file_name = MALLOC(len + 8);
+ verbose_file_name = MALLOC((len + 8) * sizeof(char_os));
if (verbose_file_name == 0)
no_space();
- strcpy(verbose_file_name, file_prefix);
- strcpy(verbose_file_name + len, VERBOSE_SUFFIX);
+ strcpy_os(verbose_file_name, file_prefix);
+ strcpy_os(verbose_file_name + len, VERBOSE_SUFFIX);
}
- interface_file_name = MALLOC(len + 8);
+ interface_file_name = MALLOC((len + 8) * sizeof(char_os));
if (interface_file_name == 0)
no_space();
- strcpy(interface_file_name, file_prefix);
- strcpy(interface_file_name + len, INTERFACE_SUFFIX);
+ strcpy_os(interface_file_name, file_prefix);
+ strcpy_os(interface_file_name + len, INTERFACE_SUFFIX);
}
if (input_file == 0)
{
- input_file = fopen(input_file_name, "r");
+ input_file = fopen_os(input_file_name, T("r"));
if (input_file == 0)
open_error(input_file_name);
}
#ifdef HAS_MKSTEMP
action_file = fdopen(action_fd, "w");
#else
- action_file = fopen(action_file_name, "w");
+ action_file = fopen_os(action_file_name, T("w"));
#endif
if (action_file == 0)
open_error(action_file_name);
#ifdef HAS_MKSTEMP
entry_file = fdopen(entry_fd, "w");
#else
- entry_file = fopen(entry_file_name, "w");
+ entry_file = fopen_os(entry_file_name, T("w"));
#endif
if (entry_file == 0)
open_error(entry_file_name);
#ifdef HAS_MKSTEMP
text_file = fdopen(text_fd, "w");
#else
- text_file = fopen(text_file_name, "w");
+ text_file = fopen_os(text_file_name, T("w"));
#endif
if (text_file == 0)
open_error(text_file_name);
if (vflag)
{
- verbose_file = fopen(verbose_file_name, "w");
+ verbose_file = fopen_os(verbose_file_name, T("w"));
if (verbose_file == 0)
open_error(verbose_file_name);
}
- if (dflag)
- {
- defines_file = fopen(defines_file_name, "w");
- if (defines_file == 0)
- open_error(defines_file_name);
- }
-
- output_file = fopen(output_file_name, "w");
+ output_file = fopen_os(output_file_name, T("w"));
if (output_file == 0)
open_error(output_file_name);
if (rflag)
{
- code_file = fopen(code_file_name, "w");
+ code_file = fopen_os(code_file_name, T("w"));
if (code_file == 0)
open_error(code_file_name);
}
code_file = output_file;
- interface_file = fopen(interface_file_name, "w");
+ interface_file = fopen_os(interface_file_name, T("w"));
if (interface_file == 0)
open_error(interface_file_name);
}
+#ifdef _WIN32
+int wmain(int argc, wchar_t **argv)
+#else
int main(int argc, char **argv)
+#endif
{
set_signals();
getargs(argc, argv);
register FILE *in, *out;
fclose(text_file);
- text_file = fopen(text_file_name, "r");
+ text_file = fopen_os(text_file_name, T("r"));
if (text_file == NULL)
open_error(text_file_name);
in = text_file;
putc(c, out);
}
if (!lflag)
- fprintf(out, line_format, ++outline + 1, code_file_name);
+ fprintf(out, line_format, ++outline + 1, code_file_name_disp);
}
if (!lflag)
{
++outline;
- fprintf(out, line_format, lineno, input_file_name);
+ fprintf(out, line_format, lineno, input_file_name_disp);
}
if (c == '\n')
++outline;
if (!lflag)
{
++outline;
- fprintf(out, line_format, lineno, input_file_name);
+ fprintf(out, line_format, lineno, input_file_name_disp);
}
do { putc(c, out); } while ((c = *++cptr) != '\n');
++outline;
putc('\n', out);
}
if (!lflag)
- fprintf(out, line_format, ++outline + 1, code_file_name);
+ fprintf(out, line_format, ++outline + 1, code_file_name_disp);
}
-void copy_file(FILE **file, char *file_name)
+void copy_file(FILE **file, char_os *file_name)
{
register int c, last;
register FILE *out = code_file;
int state = 0;
fclose(*file);
- *file = fopen(file_name, "r");
+ *file = fopen_os(file_name, T("r"));
if (*file == NULL)
open_error(file_name);
case ' ': state = (state == 2) ? 3 : 0; break;
case '0':
if (state == 3){
- fprintf (out, "%d \"%s", outline+2, code_file_name);
+ fprintf (out, "%d \"%s", outline+2, code_file_name_disp);
c = '"';
}
state = 0;
int name_pool_size;
char *name_pool;
-char line_format[] = "# %d \"%s\"\n";
-
static unsigned char caml_ident_start[32] =
"\000\000\000\000\000\000\000\000\376\377\377\207\376\377\377\007\000\000\000\000\000\000\000\000\377\377\177\377\377\377\177\377";
static unsigned char caml_ident_body[32] =
&& cptr[4] == '\'') {
fwrite(cptr, 1, 5, f);
cptr += 5;
+ } else if (cptr[0] == '\\'
+ && cptr[1] == 'o'
+ && cptr[2] >= '0' && cptr[2] <= '3'
+ && cptr[3] >= '0' && cptr[3] <= '7'
+ && cptr[4] >= '0' && cptr[4] <= '7'
+ && cptr[5] == '\'') {
+ fwrite(cptr, 1, 6, f);
+ cptr += 6;
} else if (cptr[0] == '\\' && cptr[2] == '\'') {
fwrite(cptr, 1, 3, f);
cptr += 3;
process_open_curly_bracket(f);
continue;
default:
+ if (In_bitmap(caml_ident_start, c)) {
+ while (In_bitmap(caml_ident_body, *cptr)) cptr++;
+ }
continue;
}
}
if (line == 0)
unterminated_text(t_lineno, t_line, t_cptr);
}
- fprintf(f, line_format, lineno, input_file_name);
+ fprintf(f, line_format, lineno, input_file_name_disp);
loop:
c = *cptr++;
goto loop;
default:
putc(c, f);
+ if (In_bitmap(caml_ident_start, c)) {
+ while (In_bitmap(caml_ident_body, *cptr)) {
+ putc(*cptr, f);
+ cptr++;
+ }
+ }
need_newline = 1;
goto loop;
}
item->name);
}
fprintf(f, " Obj.repr(\n");
- fprintf(f, line_format, lineno, input_file_name);
+ fprintf(f, line_format, lineno, input_file_name_disp);
for (i = 0; i < cptr - line; i++) fputc(' ', f);
fputc ('(', f);
void reader(void)
{
- virtual_input_file_name = substring (input_file_name, 0,
- strlen (input_file_name));
+ virtual_input_file_name = caml_stat_strdup_of_os(input_file_name);
+ if (!virtual_input_file_name) no_space();
create_symbol_table();
read_declarations();
output_token_type();
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* David Allsopp, OCaml Labs, Cambridge. */
+/* */
+/* Copyright 2017 MetaStack Solutions Ltd. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+/* Need at least Windows Vista for WC_ERR_INVALID_CHARS */
+#define _WIN32_WINNT 0x600
+#define WINVER 0x600
+#include <windows.h>
+
+/* See corresponding values in runtime/win32.c */
+static int windows_unicode_enabled = WINDOWS_UNICODE;
+static int windows_unicode_strict = 1;
+
+/* Adapted from runtime/win32.c */
+int win_wide_char_to_multi_byte(const wchar_t *s, int slen,
+ char *out, int outlen)
+{
+ int retcode;
+
+ if (slen == 0)
+ return 0;
+
+ if (windows_unicode_enabled != 0)
+ retcode =
+ WideCharToMultiByte(CP_UTF8,
+ windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0,
+ s, slen, out, outlen, NULL, NULL);
+ else
+ retcode =
+ WideCharToMultiByte(CP_ACP, 0, s, slen, out, outlen, NULL, NULL);
+
+ if (retcode == 0)
+ return -1;
+
+ return retcode;
+}
+
+char* caml_stat_strdup_of_utf16(const wchar_t *s)
+{
+ char *out = NULL;
+ int retcode;
+
+ retcode = win_wide_char_to_multi_byte(s, -1, NULL, 0);
+ if (retcode >= 0) {
+ out = (char *)malloc(retcode);
+ win_wide_char_to_multi_byte(s, -1, out, retcode);
+ }
+
+ return out;
+}
projects / ocaml.git / commitdiff